How to color a cell within a range, if the corresponding cell within an identical range on a different worksheet is already colored?

Question

In VBA, I am flagging results within a range and coloring them green based on cell value (ex. value < "28").

Each sheet (of four total) corresponds to a different marker and is flagged green based on a value. All the sheets have an identical X and Y axis, with the range of interest being (B2:BJ26).

I would like to make a fifth sheet that colors the corresponding cell green if all four corresponding cells from the other sheets are colored green.

I could do this cell by cell.

Simplified example

If Sheets(A) "B2" value < 30 AND Sheets(B) "B2" Value > 1.1 AND
  Sheets(C) "B2" Value < 1500 AND Sheets(D) "B2" Value > 0.30 THEN
    Sheets(E) "B2" interior.color = RGB(0,255,0) 

There must be a more efficient way for all cells within the B2:BJ26 range.

Example of working code to color/flag values on the first four sheets.

Worksheets("1").Activate

Dim XXXXXXX As Range, cell As Range
Set XXXXXXX = Range("B2:BJ26")

For Each cell In XXXXXXX

    If cell.Value < "28" And cell.Value > "1" Then
        cell.Interior.Color = RGB(0, 255, 0)
    End If

Next

The suggested following code is not coloring anything on sheet 5

Sub ColorSheetFive()
    Dim i As Integer
    Dim m As Integer
    Dim n As Integer
    Dim allGreen As Boolean

    For m = 2 To 26
        For n = 2 To 62
            allGreen = True
            For i = 1 To 4
                If Sheets(i).Cells(m, n).Interior.Color <> RGB(0, 255, 0) Then
                    allGreen = False
                End If
            Next i
            If allGreen Then
                Sheets(5).Cells(m, n).Interior.Color = RGB(0, 255, 0)
            End If
        Next n
    Next m

    MsgBox "Color checking complete!"

End Sub

Answer 1

Format Same Cells

• Workbook download (Dropbox)
• An approximate (unprecise) description: This code doesn't check the first worksheets for Interior colors, it rather checks the Min and Max Criteria for each cell and applies formatting while it counts the number of occurrences of criteria met in a list, which is then checked against the number of first worksheets, and if found, the appropriate cells in the last worksheet are formatted.
• You can add more worksheets to the Worksheet Name List ( cSheets ), but the cells in the range of all, except the last worksheet, will be formatted if criteria is met, while the cells in the range of the last worksheet will be formatted only if all cells in ranges of all previous sheets have met the criteria.
• Adjust the other values in the constants section as you see fit.

The Code

Sub FormatSameCells()

    ' Worksheet Name List
    Const cSheets As String = "Sheet1,Sheet2,Sheet3,Sheet4,Sheet5"
    Const cRange As String = "B2:BJ26"  ' Source Range Address
    Const cMax As Long = 28             ' Max Criteria
    Const cMin As Long = 1              ' Min Criteria
    Const cColor As Long = 65280        ' Cell Color (Green)

    Dim rng As Range      ' Source Range, Target Range
    Dim vntS As Variant   ' Sheet Array
    Dim vntR As Variant   ' Range Array
    Dim vntT As Variant   ' Target Array
    Dim NoS As Long       ' Number of Sheets
    Dim NoR As Long       ' Number of Rows in Source Range
    Dim NoC As Long       ' Number of Columns in Source Range
    Dim i As Long         ' Range/Target Array Row Counter
    Dim j As Long         ' Sheet Array Element Counter,
                          ' Range/Target Array Column Counter
    Dim m As Long         ' Sheet Array Element Counter
    Dim str1 As String    ' Debug String

    ' Copy Worksheet Name List to 1D 0-based Sheet Array.
    vntS = Split(cSheets, ",")
    ' Calculate Number of Worksheets).
    NoS = UBound(vntS)

    With ThisWorkbook.Worksheets(Trim(vntS(UBound(vntS)))).Range(cRange)
        ' Calculate Number of Rows in Source Range/Range Array/Target Array.
        NoR = .Rows.Count
        ' Calculate Number of Columns in Source Range/Range Array/Target Array.
        NoC = .Columns.Count
    End With

    ' Adjust Target Array to size of Source Range/Range Array.
    ReDim vntT(1 To NoR, 1 To NoC) As Long

    ' Loop through all elements of Sheet Array, except the last one.
    For m = 0 To NoS - 1
        ' Create a reference to current Source Range.
        Set rng = ThisWorkbook.Worksheets(Trim(vntS(m))).Range(cRange)
        ' Clear Interior formatting in current Source Range.
        rng.Cells.Interior.ColorIndex = xlNone
        ' Copy Source Range in current worksheet (m) to 2D 1-based 1-column
        ' array in Array Array.
        vntR = rng
        ' Loop through rows of current array of Array Array.
        For i = 1 To NoR
            ' Loop through columns of current array of Array Array.
            For j = 1 To NoC
                ' Check value of current element of current array of
                ' Array Array for matching criteria.
                If vntR(i, j) > cMin And vntR(i, j) < cMax Then
                    ' Apply formatting to current cell in current Source Range.
                    rng.Cells(i, j).Interior.Color = cColor
                    ' Increase the number in current cell of Target Array.
                    vntT(i, j) = vntT(i, j) + 1
                End If
            Next
        Next
    Next

    ' Display contents of Target Array.
    str1 = String(40, "*") & vbCr & "Target Array [" & NoR & "," & NoC & "]" _
            & vbCr & String(40, "*")
    For i = 1 To NoR
        str1 = str1 & vbCr
        For j = 1 To NoC
            str1 = str1 & vntT(i, j)
        Next
    Next
    Debug.Print str1

    ' Create a reference to last (NoS) worksheet.
    Set rng = ThisWorkbook.Worksheets(Trim(vntS(NoS))).Range(cRange)
    ' Clear formatting in Target Range.
    With rng.Cells
        .Interior.ColorIndex = xlNone
        '.Font.Bold = False
    End With
    ' Loop through rows of Target Array.
    For i = 1 To NoR
        ' Loop through columns of Target Array
        For j = 1 To NoC
            ' Check if value of current element is equal to NoS.
            If vntT(i, j) = NoS Then
                ' Apply formatting to current cell in Target Range.
                With rng.Cells(i, j)
                    .Interior.Color = cColor
                    '.Font.Bold = True
                End With
            End If
        Next
    Next

End Sub

Clear Interior in all worksheets

Sub ClearInterior()

    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        ws.Cells.Interior.ColorIndex = xlNone
    Next

End Sub

Answer 2

Your code ColorSheetFive does work without any problems?!

Option Explicit

Sub ColorSheet5()
    Dim RelevantRange As Range
    Dim RangeStr As String

    'vbGreen = 65280
    'rgb(0,255,0) = 65280

    Set RelevantRange = Range("B2:BJ26")
    For Each actCell In RelevantRange
        RangeStr = actCell.Address
        'Debug.Print Sheets("Sheet" & iCt).Range(RangeStr).Address
        If Check4Sheets(RangeStr, vbGreen) Then
            actCell.Interior.Color = vbGreen
        End If
    Next actCell
End Sub

Function Check4Sheets(CheckRange As String, RGB_Color As Long) As Boolean

    Check4Sheets = True
    If Check_Intertior_Color(1, CheckRange, RGB_Color) = False Then _
        Check4Sheets = False
    If Check_Intertior_Color(2, CheckRange, RGB_Color) = False Then _
        Check4Sheets = False
    If Check_Intertior_Color(3, CheckRange, RGB_Color) = False Then _
        Check4Sheets = False
    If Check_Intertior_Color(4, CheckRange, RGB_Color) = False Then _
        Check4Sheets = False

End Function

Function Check_Intertior_Color(SheetNr As Integer, CheckRange As String, RGB_Color As Long) As Boolean
    Check_Intertior_Color = False
    With Worksheets(SheetNr).Range(CheckRange)
        If .Interior.Color = RGB_Color Then
            Check_Intertior_Color = True
        End If
    End With
End Function