Compare Words in Two Cells

• Hardly tested.

Option Explicit

Sub CompareTwoCellsTEST()
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    CompareTwoCells ws.Range("A1"), ws.Range("B1")
End Sub

Sub CompareTwoCells(ByVal ChangeCell As Range, ByVal CompareCell As Range)
    
    Dim Change() As String: Change = Split(CStr(ChangeCell.Value))
    Dim Compare() As String: Compare = Split(CStr(CompareCell.Value))
    
    Dim n As Long
    Dim Pos As Long
    Dim ch As Long
    Dim ErrNum As Long
    Dim sChange As String
    Dim sCompare As String
    
    For n = 0 To UBound(Change)
        sChange = Change(n)
        On Error Resume Next
            sCompare = Compare(n)
        On Error GoTo 0
        If Len(sCompare) > 0 Then
            If StrComp(sChange, sCompare, vbBinaryCompare) <> 0 Then
                For ch = 1 To Len(sChange)
                    If ErrNum = 0 Then
                        On Error Resume Next
                            If Mid(sChange, ch, 1) <> Mid(sCompare, ch, 1) Then
                                ChangeCell.Characters(Pos + ch, 1) _
                                    .Font.Color = vbRed
                            End If
                           ErrNum = Err.Number
                        On Error GoTo 0
                    Else
                        ChangeCell.Characters(Pos + ch, 1).Font.Color = vbRed
                    End If
                Next ch
                ErrNum = 0
            End If
            sCompare = vbNullString
        End If
        Pos = Pos + Len(sChange) + 1
    Next n

End Sub

As suggested in the comments, Split function here is your friend:

Split function

try this code:

Sub test()
Dim ControlActual As Variant
Dim ControlAntiguo As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim AcumuladoControlActual As Long
Dim AcumuladoControlAntiguo As Long


i = 4 'starting row of data

Do Until Range("A" & i).Value = ""
    ControlActual = Split(Range("A" & i).Value, " ")
    ControlAntiguo = Split(Range("B" & i).Value, " ")
    AcumuladoControlActual = 0
    AcumuladoControlAntiguo = 0
    
    For j = LBound(ControlActual) To UBound(ControlActual) Step 1
        k = 1
        Do Until k > Len(ControlActual(j)) And k > Len(ControlAntiguo(j))
            If Mid(ControlActual(j), k, 1) <> Mid(ControlAntiguo(j), k, 1) Then
                If k <= Len(ControlActual(j)) Then Range("A" & i).Characters(AcumuladoControlActual + k, 1).Font.Color = RGB(255, 0, 0)
                If k <= Len(ControlAntiguo(j)) Then Range("B" & i).Characters(AcumuladoControlAntiguo + k, 1).Font.Color = RGB(255, 0, 0)
            End If
            k = k + 1
        Loop
        
        AcumuladoControlActual = AcumuladoControlActual + Len(ControlActual(j)) + 1
        AcumuladoControlAntiguo = AcumuladoControlAntiguo + Len(ControlAntiguo(j)) + 1
    Next j
    i = i + 1
Loop

End Sub

Anyways, this will work properly only if both phrases got same quantity of words and in the same expected order. Totally diferent phrases may produce weird results.

This code more or less does the trick. It shows where the words are the same by chaining its color to green. This way you can differentiate between the words that are the same (color green) and the ones that are different (standard color).

Hope this helps anyone that had the same problem as mine.

Sub find_differences()

Dim xStr() As String
Dim i As Long
Dim x As Long, y As Long

With ActiveSheet
For i = 3 To .Cells(.Rows.Count, "G").End(xlUp).Row
xStr = Split(.Cells(i, "G").Value, " ")
xStrH = Split(.Cells(i, "H").Value, " ")


With .Cells(i, "H")
.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 = 4


End If
Next y
Next x
End With
Next i
End With

 End Sub