Maybe give this code a try. PS: Text comparison is case sensitive. Apple <> apple
Sub CompareText()
Dim LR As Long, i As Long
Dim j As Integer
Dim txt As Variant
Dim sResult As String
Dim wsData As Worksheet
Set wsData = ThisWorkbook.Worksheets("Sheet1")
With wsData
LR = .Cells(Rows.Count, 1).End(xlUp).Row
.Columns("D").ClearContents
For i = 2 To LR
txt = Split(.Cells(i, 2).Value, " ")
sResult = ""
For j = LBound(txt) To UBound(txt)
If InStr(.Cells(i, 1).Value, txt(j)) > 0 Then
sResult = sResult & " " & txt(j)
End If
Next j
.Cells(i, 4).Value = sResult
Next i
End With
End Sub
Bookmarks