Sub Demo()
Application.ScreenUpdating = False
Dim StrFnd As String, i As Long
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Replacement.Text = "^&"
  .Forward = True
  .Format = True
  .Wrap = wdFindContinue
  .MatchCase = True
  .MatchWholeWord = True
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  StrFnd = "One,Two,Three"
  For i = 0 To UBound(Split(StrFnd, ","))
    .Text = Split(StrFnd, ",")(i)
    .Replacement.Font.ColorIndex = wdBlue
    .Execute Replace:=wdReplaceAll
  Next
  StrFnd = "Four,Five,Six"
  For i = 0 To UBound(Split(StrFnd, ","))
    .Text = Split(StrFnd, ",")(i)
    .Replacement.Font.ColorIndex = wdRed
    .Execute Replace:=wdReplaceAll
  Next
  StrFnd = "Seven,Eight,Nine,Ten"
  For i = 0 To UBound(Split(StrFnd, ","))
    .Text = Split(StrFnd, ",")(i)
    .Replacement.Font.ColorIndex = wdGreen
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub