One way:

To put all the terms into one cell, replace the Do...Loop with:

Do
With rFound.Offset(0, 1)
.Value = IIf(IsEmpty(.Value), "", _
.Text & ", ") & vKeyWords(i)
End With
Set rFound = .FindNext(After:=rFound)
Loop Until rFound.Address = sFoundAddr

To put applicable terms into adjoining cells, replace the do loop
with:

Do
With rFound.Offset(0, 1).Resize(
1, UBound(vKeyWords))
.Item(Application.CountA(.Cells) + _
1).Value = vKeyWords(i)
End With
Set rFound = .FindNext(After:=rFound)
Loop Until rFound.Address = sFoundAddr

In article ,
"Stuart" wrote:

It would be of great help to me, if you could demonstate
the technique for the situation where multiple keywords
could exist within the same cell.