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