VBA to Match word by word from a cell to word by word in an another cell

Question

I am trying to match each an every word in column A to each and every word in column B. In other words, I want to check if the words of column A are present in column B. If yes, then highlight the same in Column B.

I have tried the below code, but this looks for an exact match.

Dim xStr As String
    Dim i, Y As Variant
    Dim M, j As Long


count = Range("A4", Range("A4").End(xlDown)).Rows.count

For i = 4 To count + 3
    xStr = Range("B" & i).value
       With Range("G" & i)
        .Font.ColorIndex = 1
        For j = 1 To Len(.Text)
            If Mid(.Text, j, Len(xStr)) = xStr Then .Characters(j, Len(M)).Font.ColorIndex = 3
        Next j
      End With

 Next i

Example :

Column A# BAND AID WASHPROOF
Column B## Johnson & Johnson Washproof Antiseptic Adhesive Band-Aid (Jar)

The 3 words in column A should be highlighted in column B.

Answer 1

I assume you want to compare the words in B4 with G4, then B5 with G5 and so on - each pair individually.

If you Split the content of your cell with space as delimiter, then you have its words within an array and can compare each array element.

Private Sub CompareWords()
    Dim xStr() As String
    Dim i As Long
    Dim x As Long, y As Long

    With ActiveSheet
        For i = 4 To .Cells(.Rows.Count, "B").End(xlUp).Row
            xStr = Split(.Cells(i, "B").Value, " ")
            With .Cells(i, "G")
                .Font.ColorIndex = 1
                For x = LBound(xStr()) To UBound(xStr())
                    For y = 1 To Len(.Text)
                        If Mid(.Text, y, Len(xStr(x))) = xStr(x) Then
                            .Characters(y, Len(xStr(x))).Font.ColorIndex = 3
                        End If
                    Next y
                Next x
            End With
        Next i
    End With
End Sub