How to compare text of same row in two different columns and return matching words?

This is the best I could come up with. Hope you can find a use for it.

Sub guest2013()
Dim i As Long
Dim x As String
For i = 2 To Range("A" & Rows.Count).End(3).Row
    Select Case Len(Cells(i, "A"))
        Case Is > Len(Cells(i, "B"))
            x = Left(Cells(i, "B"), 4)
                If Cells(i, "A").Value Like "*" & x & "*" Then Cells(i, "D") = Cells(i, "B")
        Case Is < Len(Cells(i, "B"))
            x = Left(Cells(i, "A"), 4)
                If Cells(i, "B").Value Like "*" & x & "*" Then Cells(i, "D") = Cells(i, "A")
    End Select
Next i
End Sub