For each Loop Will Not Work Search for Value On on

Question

I have a list of true and false values on sheet 3 column A and a list of codes on sheet 2 Column A. If the value on sheet 3 A5 is = True then I want the value on sheet 2 A5 should be colored red. And If the value on sheet 3 A6 is = True then I want the value on sheet 2 A6 should be colored red. And this should move down along Column A on sheet 2 and sheet 3 until data runs out. So far i have got it to work for the first cell in column A but can not get the For Each loop to work. Any Help would be greatly appreciated.

Sub compare_cols()

    Dim myRng As Range
    Dim lastCell As Long

    'Get the last row
    Dim lastRow As Integer
    lastRow = ActiveSheet.UsedRange.Rows.Count

    'Debug.Print "Last Row is " & lastRow

    Dim c As Range
    Dim d As Range

    Set c = Worksheets("Sheet3").Range("A5:25")
    Set d = Worksheets("Sheet2").Range("A5:25")


    Application.ScreenUpdating = False

     For Each cell In c
     For Each cell In d

            If c.Value = True Then
            d.Interior.Color = vbRed
            End If

Next
Next

    Application.ScreenUpdating = True

End Sub   

Answer 1

A more efficient solution wouldn't necessarily next 2 loops within each other. Instead, loop through the range that you'd like to check, and reference the cells Address property to identify new cells to highlight.

Check the code below and let me know if you understand it

Sub ColorOtherSheet()
    Dim wsCheck As Worksheet
    Dim wsColor As Worksheet
    Dim rngLoop As Range
    Dim rngCell As Range

    Set wsCheck = Worksheets("Sheet3")
    Set wsColor = Worksheets("Sheet2")
    Set rngLoop = Intersect(wsCheck.UsedRange, wsCheck.Columns(1))

    For Each rngCell In rngLoop
        If rngCell.Value = True Then
            wsColor.Range(rngCell.Address).Interior.Color = vbRed
        End If
    Next rngCell


End Sub