Listing Conditional Formatting on Separate Sheet or Workbook

[vanhunk]

Hi snb,
I have replaced the following line:

       Sheets("overzicht").cells(1).currentregion.Columns(1).offset(2).TextToColumns , , , , 0, 0, 0, 0, -1, "|"

with

        Sheets("overzicht").Cells(3, 1).CurrentRegion.Columns(1).TextToColumns , , , , 0, 0, 0, 0, -1, "|"

and got the desired results.

The code now look as follows:

Sub M_snbModified()
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 cl In Worksheets("GTL Dashboard").Cells.SpecialCells(xlCellTypeAllFormatConditions)
             
            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 = "overzicht"
        Sheets("overzicht").Cells(3, 1).Resize(.Count) = Application.Transpose(.items)
        Sheets("overzicht").Cells(3, 1).CurrentRegion.Columns(1).TextToColumns , , , , 0, 0, 0, 0, -1, "|"
        
    End With
End Sub

Regards,
vanhunk

[snb]

No objection your honour.

[r.d-moore]

PLEASE HELP!!

I am crossing my fingers that someone is still around to help me with this.
I am trying desperately to implement this code into my workbook in an attempt to get a list of all Conditional Formatting rules.
I am only able to get the column headers to show when running the code. I am unable to get anything to populate under the headers.

Hi snb,
I have replaced the following line:

       Sheets("overzicht").cells(1).currentregion.Columns(1).offset(2).TextToColumns , , , , 0, 0, 0, 0, -1, "|"

with

        Sheets("overzicht").Cells(3, 1).CurrentRegion.Columns(1).TextToColumns , , , , 0, 0, 0, 0, -1, "|"

and got the desired results.

The code now look as follows:

Sub M_snbModified()
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 cl In Worksheets("GTL Dashboard").Cells.SpecialCells(xlCellTypeAllFormatConditions)
             
            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 = "overzicht"
        Sheets("overzicht").Cells(3, 1).Resize(.Count) = Application.Transpose(.items)
        Sheets("overzicht").Cells(3, 1).CurrentRegion.Columns(1).TextToColumns , , , , 0, 0, 0, 0, -1, "|"
        
    End With
End Sub

Regards,
vanhunk

[vanhunk]

Hi r.d-moore,
I trust by now you have solved your problem, if not, please load a copy of your spreadsheet and I will have a look at it.

Regards
vanhunk