Word VBA Find and Highlight matches

i have the codes below that is already working but still needs to be fine tuned. Its a function that finds matches for a wildcard search string and highlights the occurences. But i believe that it can still be done in a single line using replace all. I have tried almost everything that i could possibly think of and i think its time to ask the experts about this. Please show me how this can be done in a yet shorter way. Any help will be greatly appreciated. Thanks!

Sub findfunction()
If (findHL(activedocument.Range, "[aeiou]")) = True Then MsgBox "Highlight vowels Done", vbInformation + vbOKOnly, "Vowels Highlight Result"
End Sub

Function findHL(r As Range, s As String) As Boolean
Dim rdup As Range
Set rdup = r.Duplicate
rdup.Find.Wrap = wdFindStop

Do While rdup.Find.Execute(findtext:=s, MatchWildcards:=True) = True
   If (Not rdup.InRange(r)) Then Exit Do
   rdup.HighlightColorIndex = wdBlue
   rdup开发者_高级运维.Collapse wdCollapseEnd
Loop

findHL = True
End Function

Hidden very deep inside google:

Options.DefaultHighlightColorIndex = wdYellow

Selection.find.HitHighlight( string ) 

I managed to find my own solution doing a few trials. Here is my solution just for reference to others who might be looking for the same solution to my previous problem:

Sub findfunction()
If (findHL(activedocument.Content, "[aeiou]")) = True Then MsgBox "Highlight vowels Done", vbInformation + vbOKOnly, "Vowels Highlight Result"
End Sub

Function findHL(r As Range, s As String) As Boolean
Options.DefaultHighlightColorIndex = wdBlue
r.Find.Replacement.highlight = True
r.Find.Execute FindText:=s, MatchWildcards:=True, Wrap:=wdFindContinue, Format:=True,  replacewith:="", replace:=wdReplaceAll
findHL = True
End Function

Simple yet it stripped down my previous code to a few lines.