Sub findfunction()
If (findHL(activedocument.Range, "[56, 47, 44, 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

Sub HilightVowels()
Application.ScreenUpdating = False
With ActiveDocument.Range
  .HighlightColorIndex = wdYellow
  With .Find
  .ClearFormatting
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .MatchWildcards = True
  .Text = "[!AEIOUaeiou]"
  With .Replacement
    .ClearFormatting
    .Highlight = False
    .Text = "^&"
  End With
  .Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub