Create Summary of tabs with conditional formatting-CodePudding

I need to create a summary page that will report ONLY tabs that contain conditional formatting that's true. So Tab1 contains a comparison of Before and After; the After will highlight any cells that are different than the Before; then the macro loops to do this with a new tab for every .jbi file in a folder. So each .jbi will have a copy of Tab1 named differently. I'm not sure which method would be better to identify tabs with highlighted changes on a summary page nor really how to go about searching each tab for them.

So my questions are - Should I 1.) make it part of the .jbi import loop where it creates a new copy of Tab1, pastes the before and after data, then resets the template 2.) have it look for changes once it has completed creating new tabs? 3.) How do I get it to search for true conditional formats either way?

Edit: Using the suggestion in the first comment, this is what I came up with, but it doesn't work. It never copies the values

Sub Create_summary()
Dim inputarea As Range
Set inputarea = Sheets("PGM Copy Template").Range("AF2:BA1000")


If inputarea.DisplayFormat.Interior.ColorIndex = 49407 Then
    Sheets("Change Summary").Select
    Rows("3:3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        If Sheets("PGM Copy Template").Range("F4").Value = "#N/A" Then
        Sheets("Change Summary").Range("B3").Text = Sheets("PGM Copy Template").Range("AI5").Text
        Sheets("Change Summary").Range("C3").Text = Sheets("PGM Copy Template").Range("AI4").Text
        Else
        Sheets("Change Summary").Range("B3").Text = Sheets("PGM Copy Template").Range("F5").Text
        Sheets("Change Summary").Range("B3").Text = Sheets("PGM Copy Template").Range("F4").Text
        End If
Else
    Exit Sub
End If

End Sub

I guess I need help understanding how I can make the If/then function with the search.

CodePudding user response：

A bit easier to split out the check for the CF color:

Sub Create_summary()
    Const CHECK_COLOR As Long = 49407 'use Const for fixed values
    Dim inputarea As Range, wb As Workbook, wsInput As Worksheet, c As Range
    Dim wsSummary As Worksheet, isNA As Boolean
    
    Set wb = ThisWorkbook    'ActiveWorkbook?        'use a workbook variable
    Set wsInput = wb.Worksheets("PGM Copy Template") 'use worksheet variables
    Set wsSummary = wb.Worksheets("Change Summary")
    
    If HasCfColor(wsInput.Range("AF2:BA1000"), CHECK_COLOR) Then
        isNA = wsInput.Range("F4").Value = "#N/A"
        With Sheets("Change Summary")
            .Rows(3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Range("B3").Text = wsInput.Range(IIf(isNA, "AI5", "F5")).Text
            .Range("C3").Text = wsInput.Range(IIf(isNA, "AI4", "F4")).Text
        End With
    End If

End Sub

'Does range `rngToCheck` contain a cell with CF coloring of `cfColor` ?
Function HasCfColor(rngToCheck As Range, cfColor As Long)
    Dim rng As Range, c As Range
    
    On Error Resume Next 'ignore error if no CF in this range
    Set rng = rngToCheck.SpecialCells(xlCellTypeAllFormatConditions) 'only cells with CF
    On Error GoTo 0      'stop ignoring errors
    
    If Not rng Is Nothing Then 'True if have any  cells with CF
        For Each c In rng.Cells
            If c.DisplayFormat.Interior.Color = cfColor Then
                HasCfColor = True
                Exit Function 'done checking
            End If
        Next c
    End If
    HasCfColor = False
End Function