list conditional formatting details with VBA

I inherited a workbooks with too many conditional formattings in them. i need help with VBA that when i run in a workbook, it lists all of the details of conditional formatting in active workbook.  attached is the example how the macro should generate the report.


thanks.
Book1.xlsm
LVL 6
FloraAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

byundtMechanical EngineerCommented:
Normally, the error message says that you have too many formats or styles. One very good tool for remedying this problem is the free XLStylesTool posted at https://sergeig888.wordpress.com/2009/10/13/sharing-useful-utilities/. I have recommended the Silverlight version of this tool in the past because it works even if your Excel workbook is hosed.

If you really want a list of the conditional formatting in your worksheet, then take a look at Microsoft Excel MVP Dick Kusleika's macro at http://dailydoseofexcel.com/archives/2010/04/16/listing-format-conditions/  The output isn't quite what you asked for, but it does list all the conditional formats and their formulas.
0
FloraAuthor Commented:
thanks byundt for this, however the site your referred me, had the below code and when i used it, it is kinda useful, however it lacks two things

A) in the range column it does not refer the worksheet reference name
B) it does not refer the color

i would appreciate if someone could help with the abovementioned

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 

Open in new window

0
byundtMechanical EngineerCommented:
I modified Dick Kusleika's code so it would work on every worksheet in the active workbook (with several specified exceptions), and would add the color and worksheet name to the report. I also made it list every format condition (the original code only listed the first).
Sub ShowConditionalFormatting()
'Original code by Dick Kusleika http://dailydoseofexcel.com/archives/2010/04/16/listing-format-conditions/
'Modified by Brad Yundt
    Dim cf As Variant
    Dim rCell As Range
    Dim colFormats As Collection
    Dim i As Long, nRows As Long
    Dim ws As Worksheet, wsOutput As Worksheet
     
    Application.ScreenUpdating = False
    With ActiveWorkbook     'Put Conditional Formatting report in this workbook
        On Error Resume Next
        Set wsOutput = .Worksheets("Conditional Formats")
        On Error GoTo 0
        If wsOutput Is Nothing Then
            Set wsOutput = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            wsOutput.Name = "Conditional Formats"
        End If
        wsOutput.Cells.ClearContents
        wsOutput.Range("A1:G1").Value = Array("Type", "Worksheet", "Range", "StopIfTrue", "Formula1", "Formula2", "Color")
    End With
    
    For Each ws In ActiveWorkbook.Worksheets    'List Conditional Formatting from this workbook
        nRows = wsOutput.Cells(wsOutput.Rows.Count, 1).End(xlUp).Row
        
        Select Case ws.Name
        Case wsOutput.Name          'Ignore the Conditional Formatting report worksheet
        Case "Report", "Master"       'Ignore these worksheets
        Case Else
            Set colFormats = Nothing
            Set colFormats = New Collection
             
            For Each rCell In ws.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 & "|" & i
                    On Error GoTo 0
                Next i
            Next rCell
                          
            For i = 1 To colFormats.Count
                Set cf = colFormats(i)
                 
                With wsOutput.Cells(i + nRows, 1)
                    .Value = FCTypeFromIndex(cf.Type)
                    .Offset(0, 1).Value = ws.Name
                    .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
                    Select Case .Value
                    Case "Expression", "Text"   'Show fill color for formula or text Conditional Formatting
                        .Offset(0, 6).Interior.Color = cf.Interior.Color
                    End Select
                    On Error GoTo 0
                End With
            Next i
         
        End Select
    Next
    
    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

Open in new window

0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

FloraAuthor Commented:
many thanks byundt .  almost there.

it works it generates the report with the colors etc all good details, however on line 35 i get runtime error 1004 "no cells were found"

any idea why this error is happening?
0
byundtMechanical EngineerCommented:
Flora,
I changed the code after my original post. Your reference to statement 35 must have been to the original post, because that line is now a statement turning off error handling. I apologize for creating this confusion.

I assume that the problem was caused by a lack of conditional formatting on a particular worksheet, and hence caused a problem in the For loop of the following statement:
For Each rCell In ws.Cells.SpecialCells(xlCellTypeAllFormatConditions).Cells

Open in new window


I attempted to fix the problem in the code below.
Sub ShowConditionalFormatting()
'Original code by Dick Kusleika http://dailydoseofexcel.com/archives/2010/04/16/listing-format-conditions/
'Modified by Brad Yundt
    Dim cf As Variant
    Dim rCell As Range, rg As Range
    Dim colFormats As Collection
    Dim i As Long, nRows As Long
    Dim ws As Worksheet, wsOutput As Worksheet
     
    Application.ScreenUpdating = False
    With ActiveWorkbook     'Put Conditional Formatting report in this workbook
        On Error Resume Next
        Set wsOutput = .Worksheets("Conditional Formats")
        On Error GoTo 0
        If wsOutput Is Nothing Then
            Set wsOutput = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            wsOutput.Name = "Conditional Formats"
        End If
        wsOutput.Cells.ClearContents
        wsOutput.Range("A1:G1").Value = Array("Type", "Worksheet", "Range", "StopIfTrue", "Formula1", "Formula2", "Color")
    End With
    
    For Each ws In ActiveWorkbook.Worksheets    'List Conditional Formatting from this workbook
        nRows = wsOutput.Cells(wsOutput.Rows.Count, 1).End(xlUp).Row
        
        Select Case ws.Name
        Case wsOutput.Name          'Ignore the Conditional Formatting report worksheet
        Case "Report", "Master"       'Ignore these worksheets
        Case Else
            Set colFormats = Nothing
            Set colFormats = New Collection
             
            Set rg = Nothing
            On Error Resume Next
            Set rg = ws.Cells.SpecialCells(xlCellTypeAllFormatConditions)
            On Error GoTo 0
            
            If Not rg Is Nothing Then
                For Each rCell In rg.Cells
                    For i = 1 To rCell.FormatConditions.Count
                        On Error Resume Next
                        colFormats.Add rCell.FormatConditions.Item(i), rCell.FormatConditions(i).AppliesTo.Address & "|" & i
                        On Error GoTo 0
                    Next i
                Next rCell
                              
                For i = 1 To colFormats.Count
                    Set cf = colFormats(i)
                     
                    With wsOutput.Cells(i + nRows, 1)
                        .Value = FCTypeFromIndex(cf.Type)
                        .Offset(0, 1).Value = ws.Name
                        .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
                        Select Case .Value
                        Case "Expression", "Text"   'Show fill color for formula or text Conditional Formatting
                            .Offset(0, 6).Interior.Color = cf.Interior.Color
                        End Select
                        On Error GoTo 0
                    End With
                Next i
            End If
         
        End Select
    Next
    
    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

Open in new window

If the above tweak is still causing a problem, could you please post a workbook that reproduces the error?
1

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FloraAuthor Commented:
byundt

thank you very much. this is great and it worked perfectly.  your skills and your willingness to share, indeed are worthy of big awards.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.