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
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.
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.
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
