Listing Conditional Formatting on Separate Sheet or Workbook

[vanhunk]

Listing Conditional Formatting on Separate Sheet or Workbook:

I have found the impressive looking code below, written by Dick Kusleika, and tried to use it for my purposes. The code was written to list the first and second conditional formatting conditions, but only managed to list all the first conditions in my case. (I use Excel 2010).

I would like to get it to work for the second condition, as well as third conditions if possible, but I don't have a clue of how to fix it.
I would really like to list all 3 conditions (all conditions are expressions).

Even if it can only be done for a single cell at a time (i.e. no counting required), it would be of great assistance.


I have attached an example of the type of conditional formatting I have, as well as the output of the code below. Note that only the first condition is listed.

Original code by Dick Kusleika at the following url:
http://dailydoseofexcel.com/archives...comment-399333

Any help would be greatly appreciated.

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

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

Thank you very much,
Regards,
vanhunk