Sub FindWord_and_ChangeColor()

Dim LastRow, i As Long

Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Text = "put your text here"
.Execute
End With
Do While Selection.Find.Found
Selection.Expand Unit:=wdSentence
Selection.Font.ColorIndex = wdGreen
Selection.Collapse Direction:=wdCollapseEnd
Selection.Find.Execute
Loop
End Sub