The following should do the trick for selected text
Code:
Sub Highlight_Plus_Adjacent_Words()
Dim MyWords As Variant
Dim RngWords As Range
Dim oRng As Range
Dim i As Integer
MyWords = Split("one,two,three,four,five", ",")
Set oRng = Selection.Range
For i = 0 To UBound(MyWords)
Set RngWords = oRng
With RngWords.Find
Do While .Execute(FindText:=MyWords(i), MatchWholeWord:=True)
With RngWords
.Start = .Previous.Words(1).Start
.End = .Next.Words(1).Next.Words(1).End
.MoveEndWhile Chr(32), wdBackward
.HighlightColorIndex = wdYellow
.Collapse 0
If .Start >= oRng.End Then Exit Do
End With
Loop
End With
Next i
lbl_Exit:
Set oRng = Nothing
Set RngWords = Nothing
Exit Sub
End Sub