Sub FindAndDo() ' Paul Beverley - Version 08.08.22 ' Finds something specific and does things to each one With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "e" .Wrap = wdFindStop .Replacement.Text = "" .Forward = True .MatchWildcards = True .MatchWholeWord = False .MatchSoundsLike = False .Execute End With myCount = 0 Do While Selection.Find.Found = True ' If you want to count them... myCount = myCount + 1 ' Note where the end of the found item is Set rng = Selection.Range.Duplicate ' and make sure you're past it rng.MoveEnd , 1 rng.Collapse wdCollapseEnd ' Do something with the thing you found Selection.Font.Italic = True ' Restart search from after the previous occurrence rng.Select ' Go and find the next occurrence (if there is one) Selection.Find.Execute DoEvents Loop MsgBox "Changed: " & myCount End Sub