Link to home
Start Free TrialLog in
Avatar of Flora Edwards
Flora EdwardsFlag for Sweden

asked on

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
Avatar of byundt
byundt
Flag of United States of America image

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.
Avatar of Flora Edwards

ASKER

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

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

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?
ASKER CERTIFIED SOLUTION
Avatar of byundt
byundt
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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.