So for the sub AmeberText() wd=Orange i have tweaked my original code to:

[Sub AmberText()
Const wdOrange As Long = 41215
Dim r As Range

Set r = ActiveDocument.Range
With r.Find
Do While .Execute(FindText:="Amber", MatchWholeWord:=True, Forward:=True) = True
r.Cells(1).Shading.BackgroundPatternColor = wdOrange
.Font.Color = wdOrange
Loop

End With

End Sub]



It will only colour the 1st "Amber" cell background to orange then it stops, any ideas on how to tweak it to change all the text Ambers the entire document?