Sub Sev_ER()
Dim r As Range
Set r = ActiveDocument.Range
With r.Find
   Do While .Execute(findtext:="severe", Forward:=True) = True
      With r
         .MoveStart 1, 3
         .MoveEnd 1, -1
         .HighlightColorIndex = wdGreen
         .Collapse 0
      End With
   Loop
End With
End Sub