Write Macro to highlight based on values in another sheet

[EAlexWolfe]

I have a workbook with multiple sheets, where the first sheet is named "Report" and the subsequent sheets are named with numbers (e.g., "1," "2," "3," etc.). In the "Report" sheet, column A lists item numbers (e.g., 1, 2, 3, ...), column AH contains "Reference Instruct Message ID," and column AI contains "Subject Instruct Message ID." The alphanumeric codes in columns AH and AI start from row 2 and can go up to row 51 (i.e., up to 50 items). In the numbered sheets, codes start from cell U3 and continue downwards. I need the macro to loop through each item number in column A of the "Report" sheet, retrieve the alphanumeric codes from columns AH and AI, and search for these codes in column U of the corresponding numbered sheet (e.g., item 1 corresponds to sheet "1"). If a code from column AH is found in column U, the macro should highlight the entire row in grey, and if a code from column AI is found in column U, it should highlight the entire row in yellow. Can anyone help me write this macro? Thanks in advance!

 

[JamesTheMann]

Sub HighlightAlphanumericCodes()
    Dim reportSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim searchRange As Range
    Dim codeAH As String
    Dim codeAI As String
    Dim foundCell As Range
    Dim i As Integer
    Dim lastItemRow As Integer
    Dim itemNumber As Integer
   
    ' Set your report worksheet
    Set reportSheet = ThisWorkbook.Sheets("Report")
   
    ' Find the last item row (up to 50 items)
    lastItemRow = Application.WorksheetFunction.Min(reportSheet.Cells(reportSheet.Rows.Count, 1).End(xlUp).Row, 51)
   
    ' Loop through items in the report sheet
    For i = 2 To lastItemRow
        itemNumber = reportSheet.Cells(i, 1).Value ' Assuming column A has the item numbers
        codeAH = reportSheet.Cells(i, 34).Value ' Column AH is the 34th column
        codeAI = reportSheet.Cells(i, 35).Value ' Column AI is the 35th column
       
        ' Check if the item number corresponds to a sheet name
        On Error Resume Next
        Set targetSheet = ThisWorkbook.Sheets(CStr(itemNumber))
        On Error GoTo 0
       
        If Not targetSheet Is Nothing Then
            Set searchRange = targetSheet.Range("U3:U" & targetSheet.Cells(targetSheet.Rows.Count, 21).End(xlUp).Row) ' Column U is the 21st column
           
            ' Search and highlight the entire row for codeAH (Grey)
            Set foundCell = searchRange.Find(What:=codeAH, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
            If Not foundCell Is Nothing Then
                foundCell.EntireRow.Interior.Color = RGB(192, 192, 192) ' Highlight color (Grey)
            End If
           
            ' Search and highlight the entire row for codeAI (Yellow)
            Set foundCell = searchRange.Find(What:=codeAI, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
            If Not foundCell Is Nothing Then
                foundCell.EntireRow.Interior.Color = RGB(255, 255, 0) ' Highlight color (Yellow)
            End If
        End If
       
        ' Clear targetSheet variable for next iteration
        Set targetSheet = Nothing
    Next i
End Sub

This should work...

 

[EAlexWolfe]

The below worked...

Sub HighlightComparableRows_ActiveWorkbook()
    Dim ws As Worksheet, lastItemRow As Integer, i As Integer, j As Integer, subjectProfit As Double
    Dim volume As Double, valueM As Double, valueN As Double, withinRange As Boolean, noHighlightRow As Integer
    Dim foundGreen As Boolean, foundBlue As Boolean, activeWb As Workbook
    Set activeWb = ActiveWorkbook
    For Each ws In activeWb.Worksheets
        If Application.WorksheetFunction.CountA(ws.Cells) = 0 Then GoTo NextSheet
        ws.Range("A4:V4").AutoFilter
        subjectProfit = ws.Range("Q2").Value
        valueM = ws.Range("M2").Value
        valueN = ws.Range("N2").Value
        lastItemRow = ws.Cells(ws.Rows.Count, 21).End(xlUp).Row
        ws.Range("A4:V" & lastItemRow).Sort Key1:=ws.Range("U5"), Order1:=xlDescending, Header:=xlYes
        ws.Range("J5:J" & lastItemRow).NumberFormat = "#,##0"
        ws.Range("K5:K" & lastItemRow).NumberFormat = "#,##0"
        foundGreen = False
        foundBlue = False
        noHighlightRow = 0
        For i = 5 To lastItemRow
            If ws.Range("H2").Value = "C" Then
                volume = ws.Cells(i, 11).Value
                If volume < 10000 Or (volume >= 10000 And volume < 50000 And volume < valueN) Or _
                   (volume >= 50000 And volume < 100000 And volume < valueN) Or _
                   (volume >= 100000 And volume < 1000000 And volume < valueN) Or _
                   (volume >= 1000000 And volume < valueN) Then
                    ws.Cells(i, 11).Interior.Color = RGB(255, 192, 192)
                End If
            End If
            If ws.Range("F2").Value = "C" Then
                volume = ws.Cells(i, 10).Value
                If volume < 10000 Or (volume >= 10000 And volume < 50000 And volume < valueM) Or _
                   (volume >= 50000 And volume < 100000 And volume < valueM) Or _
                   (volume >= 100000 And volume < 1000000 And volume < valueM) Or _
                   (volume >= 1000000 And volume < valueM) Then
                    ws.Cells(i, 10).Interior.Color = RGB(255, 192, 192)
                End If
            End If
            If InStr(1, ws.Cells(i, 4).Value, ws.Range("G2").Value, vbTextCompare) > 0 Then
                ws.Cells(i, 4).Interior.Color = RGB(255, 192, 192)
            End If
            If ws.Cells(i, 22).Value < 50 Then
                ws.Cells(i, 22).Interior.Color = RGB(255, 192, 192)
            End If
        Next i
        For i = 5 To lastItemRow
            withinRange = True
            For j = 10 To 22
                If ws.Cells(i, j).Interior.Color = RGB(255, 192, 192) Then
                    withinRange = False
                    Exit For
                End If
            Next j
            If withinRange Then
                If ws.Cells(i, 21).Value >= subjectProfit Then
                    ws.Rows(i).Interior.Color = RGB(192, 255, 192)
                    foundGreen = True
                    Exit For
                End If
                If Not foundGreen And Abs(ws.Cells(i, 21).Value - subjectProfit) <= 0.0005 Then
                    ws.Rows(i).Interior.Color = RGB(176, 196, 222)
                    foundBlue = True
                    Exit For
                End If
                If Not foundGreen And Not foundBlue And noHighlightRow = 0 Then
                    noHighlightRow = i
                End If
            End If
        Next i
        If Not foundGreen And Not foundBlue And noHighlightRow > 0 Then
            ws.Rows(noHighlightRow).Interior.Color = RGB(255, 160, 160)
        End If
NextSheet:
    Next ws
    MsgBox "Highlighting completed for all sheets."
End Sub

 

[Peter_SSs]

The below worked...

.. but did it work for the question in this thread or the other one that you recently started?

Also, when posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.