Sub ReplaceList()
Application.ScreenUpdating = False
Dim vFindText As Variant, i As Long
'highlight red words
Options.DefaultHighlightColorIndex = wdRed
vFindText = "England,France"
vFindText = vFindText & ",New Zealand,Zambia"
vFindText = Split(vFindText, ",")
With ActiveDocument.Content.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Wrap = wdFindContinue
  .MatchWholeWord = True
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  .Format = True
  .MatchCase = True
  .Replacement.Text = "^&"
  .Replacement.Highlight = True
  For i = LBound(vFindText) To UBound(vFindText)
    .Text = vFindText(i)
    .Execute Replace:=wdReplaceAll
  Next i
End With
Application.ScreenUpdating = True
End Sub