Listing Conditional Formatting Redux

Back in the day, I posted some code to list conditional formatting. It didn’t contemplate having multiple conditional formats for the same range. Because who would ever do that right? Of course that happens all the time and was very short-sighted of me. I aim to atone.

I used a Collection object because Collection objects can’t have two Keys that are the same. It’s a good way to get a unique list out of a list that contains duplicates. I used the range to which the FormatCondition applies as the key (and that was my downfall). My thought was this: I’m checking each cell individually and a FormatCondition that spans two cell would be counted twice. A FormatCondition that applied to L9:M9 would be counted for L9 and M9. By using the address as my unique key, it would only be counted once – the first time for L9 and it would error out and not be counted for M9.

Except you can have two FormatConditions that apply to L9:M9 and only the first would every be counted. I needed a way to identify what was a duplicate and what was a legitimate second FormatCondition. I cleverly devised (read stole from Bob Phillips) that I would add the count to the end of the address. But I got lucky in that it failed for my particular setup. The way my FormatConditions were created, they weren’t in the same order for all the cells. So even though an FC was the same for a later cell, it was the 3rd FC instead of the 2nd, and that made it seem unique.

I set out to find a better way to uniquely identify FCs, and here it is

Public Function CFSignature(ByRef cf As Variant) As String
   
    Dim aReturn(1 To 3) As String
   
    aReturn(1) = cf.AppliesTo.Address
    aReturn(2) = FCTypeFromIndex(cf.Type)
    On Error Resume Next
        aReturn(3) = cf.Formula1
       
    CFSignature = Join(aReturn, vbNullString)
   
End Function

It’s still no guarantee of uniqueness, but if you have two FCs with the same range, the same type, and the same formula, well, you gets what you deserves. Now I can use the ‘signature’ instead of the address.

Public Sub ShowConditionalFormatting()
   
    Dim cf As Variant
    Dim rCell As Range
    Dim colFormats As Collection
    Dim i As Long
    Dim wsOutput As Worksheet
    Dim aOutput() As Variant
   
    Set colFormats = New Collection
   
    For Each rCell In Sheet1.Cells.SpecialCells(xlCellTypeAllFormatConditions).Cells
        For i = 1 To rCell.FormatConditions.Count
            With rCell.FormatConditions
                On Error Resume Next
                    colFormats.Add .Item(i), CFSignature(.Item(i))
                On Error GoTo 0
            End With
        Next i
    Next rCell
       
    ReDim aOutput(1 To colFormats.Count + 1, 1 To 5)
   
    Set wsOutput = Workbooks.Add.Worksheets(1)
    aOutput(1, 1) = "Type": aOutput(1, 2) = "Range"
    aOutput(1, 3) = "StopIfTrue": aOutput(1, 4) = "Formual1"
    aOutput(1, 5) = "Formual2"
   
    For i = 1 To colFormats.Count
        Set cf = colFormats.Item(i)
           
        aOutput(i + 1, 1) = FCTypeFromIndex(cf.Type)
        aOutput(i + 1, 2) = cf.AppliesTo.Address
        aOutput(i + 1, 3) = cf.StopIfTrue
        On Error Resume Next
            aOutput(i + 1, 4) = "'" & cf.Formula1
            aOutput(i + 1, 5) = "'" & cf.Formula2
        On Error GoTo 0
    Next i
   
    wsOutput.Range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
    wsOutput.UsedRange.EntireColumn.AutoFit
   
End Sub

And in case you forgot, here’s how I got the type.

Function FCTypeFromIndex(lIndex As Long) As String
   
    Select Case lIndex
        Case 12: FCTypeFromIndex = "Above Average"
        Case 10: FCTypeFromIndex = "Blanks"
        Case 1: FCTypeFromIndex = "Cell Value"
        Case 3: FCTypeFromIndex = "Color Scale"
        Case 4: FCTypeFromIndex = "DataBar"
        Case 16: FCTypeFromIndex = "Errors"
        Case 2: FCTypeFromIndex = "Expression"
        Case 6: FCTypeFromIndex = "Icon Sets"
        Case 14: FCTypeFromIndex = "No Blanks"
        Case 17: FCTypeFromIndex = "No Errors"
        Case 9: FCTypeFromIndex = "Text"
        Case 11: FCTypeFromIndex = "Time Period"
        Case 5: FCTypeFromIndex = "Top 10?"
        Case 8: FCTypeFromIndex = "Unique Values"
        Case Else: FCTypeFromIndex = "Unknown"
    End Select
       
End Function

Now this

gets you this

5 Comments

  1. Sebastien Labonne says:

    Thanks for the update. I made a modification to list the CF for all worksheets.

    Sub ShowConditionalFormatting()

        Dim cf As Variant
        Dim rCell As Range
        Dim colFormats As Collection
        Dim i As Long
        Dim wb As Workbook
        Dim wsOutput As Worksheet
        Dim ws As Worksheet
        Dim aOutput() As Variant
       
        Set wb = ActiveWorkbook
        Set colFormats = New Collection
        Set wsOutput = Workbooks.Add.Worksheets(1)
       
        wsOutput.Range("A1:F1").Value = Array("Worksheet", "Type", "Range", "StopIfTrue", "Formula1", "Formula2")

       
    ' Populate of the Collection of format conditions
        For Each ws In wb.Worksheets
            On Error Resume Next
            For Each rCell In ws.Cells.SpecialCells(xlCellTypeAllFormatConditions).Cells
                For i = 1 To rCell.FormatConditions.Count
                    With rCell.FormatConditions
                        colFormats.Add .Item(i), CFSignature(.Item(i))
                    End With
                Next i
            Next rCell
            On Error GoTo 0
        Next
       
    ' Transfer the Collection on the Output worksheet
        For i = 1 To colFormats.Count
            Set cf = colFormats(i)
           
            With wsOutput.Cells(i + 1, 1)
                .Value = cf.Parent.Parent.Name
                .Offset(0, 1) = FCTypeFromIndex(cf.Type)
                .Offset(0, 2).Value = cf.AppliesTo.Address
                .Offset(0, 3).Value = cf.StopIfTrue
                On Error Resume Next
                    .Offset(0, 4).Value = "'" & cf.Formula1
                    .Offset(0, 5).Value = "'" & cf.Formula2
                On Error GoTo 0
            End With
        Next i

    End Sub

    I often have the same rule, with the same AplliesTo adress across many worksheets, so I also had to modify the CFSignature function to

    Public Function CFSignature(ByRef cf As Variant) As String
         
         Dim aReturn(1 To 4) As String
         
         aReturn(1) = cf.Parent.Parent.Name  ' Worksheet name
         aReturn(2) = cf.AppliesTo.Address
         aReturn(3) = FCTypeFromIndex(cf.Type)
         On Error Resume Next
             aReturn(4) = cf.Formula1
             
         CFSignature = Join(aReturn, vbNullString)
         
    End Function
  2. Jeff Weir says:

    Curious: What do you use the output for?

  3. Sebastien Labonne says:

    Jeff,

    When Excel crashes and I get the message “a number of invalid conditional formats were deleted” when Excel restarts and opens the recovered file. I might compare the recovered file with my last save instead of redoing the changes on my original file and maybe missing something.

    Also, I like to keep my workbook clean and consistent so that’s useful to have a list to scroll on one sheet instead of the Excel dialog.

    Seb

  4. Dick Kusleika says:

    I use it for showing off mostly. I don’t remember why I wrote originally.

  5. Jeff Weir says:

    @Dick: where have I heard that before?

    Oh yeah…

    We choose to go to the Conditional Formatting Rules Manager. We choose to go to the Conditional Formatting Rules Manager in this post and do the other things, not because they are easy, but because they are hard, because that goal will serve to organize and measure the best of our energies and skills, because that challenge is one that we are willing to accept, one we are unwilling to postpone, and one which we intend to win, and the others, too.”

Posting code or formulas in your comment? Use <code> tags!

  • <code lang="vb">Block of code goes here</code>
  • <code lang="vb" inline="true">Inline code goes here</code>
  • <code>Formula goes here</code>

Leave a Reply

Here's how to update your reports of company and nearly any web data: