test

Sub LoopRange()

    Dim rCell As Range
    Dim aRangeRng As Range
    Dim bRangeRng As Range
    Dim Rng As Range
    Dim FindString As String


    Set aRangeRng = ActiveWorkbook.ActiveSheet.Range("A2:A2438")
    Set bRangeRng = ActiveWorkbook.ActiveSheet.Range("B2:S2438")
    For Each aCell In bRangeRng
        FindString = aCell.Value
        With aRangeRng
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            aCell.Interior.ColorIndex = 37
        Else
            aCell.Interior.ColorIndex = 38
        End If
        End With

    Next aCell
End Sub