Stuck in an infinite While loop inside a find function

[Kilroy]

This will change the first occurrence of a highlighted word from yellow to teal. Not sure how to add specific text (Test).

Sub SearchAnyHighlight()
 Dim hiliRng As Range
 Set hiliRng = ActiveDocument.Content
 With hiliRng.Find
 .Highlight = True
 .Execute
 .Wrap = wdFindEnd
 hiliRng.Find.Execute
 If hiliRng.HighlightColorIndex = wdYellow Then
 hiliRng.HighlightColorIndex = wdTeal
 Selection.Find.Execute Replace:=wdFindEnd
 End If
 End With
 End Sub