Function PartialExists(StartCell As String, SearchRange As Range) As Boolean
Dim WordCount As Integer
PartialExists = False
WordCount = Len(StartCell) - Len(WorksheetFunction.Substitute(StartCell, " ", "")) + 1
Dim MyWords(1 To 100) As String
Dim LastSpace As Integer
Dim NextSpace As Integer
'Build list of words
LastSpace = 1
For i = 1 To WordCount
If i = WordCount Then
NextSpace = 999
Else
NextSpace = WorksheetFunction.Find(" ", StartCell, LastSpace)
End If
MyWords(i) = Mid(StartCell, LastSpace, NextSpace - LastSpace)
LastSpace = NextSpace + 1
Next i
'check if any word exists
Dim xExists As Variant
For i = 1 To WordCount
On Error Resume Next
xExists = SearchRange.Find(MyWords(i))
On Error GoTo 0
If xExists <> "" Then
PartialExists = True
Exit Function
End If
Next i
End Function