How many words? One approach is to use a pair of arrays to hold the words and the colours associated with those words. e.g.
Code:
Sub Macro1()
'Graham Mayor - https://www.gmayor.com - Last updated - 29 Sep 2019
Dim vFindText As Variant
Dim vColor As Variant
Dim i As Long
vFindText = Array("Lorem", "ipsum", "amet") 'The word list
vColor = Array(wdYellow, wdTurquoise, wdBrightGreen) 'The same number of items in this list as in the word list
For i = 0 To UBound(vFindText)
Options.DefaultHighlightColorIndex = vColor(i)
With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = vFindText(i)
.Replacement.Text = "^&"
.Replacement.Highlight = True
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End With
Next i
End Sub