Listing Conditional Formatting Rules

[Nanogirl21]

I have an old code that was able to report all Conditional Formatting rules on the active sheet into a new sheet as text infromation. For some reason I can't seem to get it to work anymore. I am not recieving an error, but the code isn't reporting the Conditional Formatting rules, only the headers. Can someone please take a look.

Sub Conditional_Formattin_Rules()
    
    Dim sp As Variant
    Dim cl As Range
    Dim cf As Variant
    Dim c00 As String
    
    On Error Resume Next
    sp = Split("Cell Value|Expression|Color Scale|DataBar|Top 10?|Icon Sets||Unique Values|Text|Blanks|Time Period|Above Average||No Blanks||Errors|No Errors|||||", "|")
    
    With CreateObject("scripting.dictionary")
        .Item("titel") = "Type|Typename|Range|StopIfTrue|Formula1|Formula2|Formula3"
        
        For Each rCell In ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions).Cells
            
            For Each cf In cl.FormatConditions
                c00 = ""
                c00 = cf.Formula1
                
                If .exists(cf.AppliesTo.Address) Then
                    If InStr(.Item(cf.AppliesTo.Address), c00) = 0 Then .Item(cf.AppliesTo.Address) = .Item(cf.AppliesTo.Address) & "|'" & c00
                Else
                    .Item(cf.AppliesTo.Address) = cf.Type & "|" & sp(cf.Type) & "|" & cf.AppliesTo.Address & "|" & cf.StopIfTrue & "|'" & c00
                End If
            Next
        Next
        
        Sheets.Add.Name = "FINAL"
        Sheets("FINAL").Cells(3, 1).Resize(.Count) = Application.Transpose(.items)
        Sheets("FINAL").Cells(3, 1).CurrentRegion.Columns(1).TextToColumns , , , , 0, 0, 0, 0, -1, "|"
        
    End With
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

EXPECTED RESULTS SHOWS ALL CONDITIOANL FORMATTING RULES THAT WAS ON THE ORGINAL ACTIVE SHEET. THE RESULTS SHOULD BE ON A ON NEW SHEET CALLED FINAL

 

[Fluff]

Try changing the value in red to cl

For Each [COLOR=#ff0000]rCell [/COLOR]In ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions).Cells

 

[Nanogirl21]

Try changing the value in red to cl

For Each [COLOR=#ff0000]rCell [/COLOR]In ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions).Cells

I tried and nothing happen. It only created the new worksheet titled FINAL.

 

[Fluff]

Making that change worked for me. Do you have any CF on the active sheet?

 

[Nanogirl21]

yes, I have about 12 CF rules on the active sheet. I tried again not to long ago and making the correction you mentioned crashed my workbook.

 

[Fluff]

In that case all I can suggest is remove the

On Error Resume Next

and then step through the code using F8, to see what is (or isn't) happening