Andrew/Graham
Thanks. This is just a tinkering exercise. The objective was to find and highlight words starting and ending with a vowel blue, words starting with a vowel yellow and words ending with a vowel green. Of course there are complications (e.g., compound words)
Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
Set oRng = ActiveDocument.Range
oRng.HighlightColorIndex = wdAuto
oRng.Text = "Mary has an ax, a mule and an apple." & vbCr & "Tom conducted a low-grade in-depth on-site inspection."
With oRng.Find
'Finds words of three characters or more that starts and ends with a vowel.
.Text = "<[AEIOUaeiou][A-Za-z]@[AEIOUaeiou]>"
.MatchWildcards = True
.Wrap = wdFindStop
Do While .Execute
oRng.HighlightColorIndex = wdBlue
oRng.Collapse wdCollapseEnd
Loop
End With
Set oRng = ActiveDocument.Range
With oRng.Find
'Find words starting with a vowel
.Text = "<[AEIOUaeiou]*>"
.MatchWildcards = True
While .Execute
oRng.Select
If oRng.HighlightColorIndex = wdAuto Then
Select Case True
Case oRng.Words.Last.Next.Text = "-"
'Deal with compound words.
oRng.MoveEnd wdWord, 2
Do While oRng.Characters.Last = " "
oRng.End = oRng.End - 1
Loop
If oRng.Characters.Last Like "[AEIOUaeiou]" Then
oRng.HighlightColorIndex = wdBlue
Else
oRng.HighlightColorIndex = wdYellow
End If
Case oRng.Text Like "[AaI]"
'Deal with the single character words A, I and a.
oRng.HighlightColorIndex = wdBlue
Case Len(oRng) = 2 And oRng.Characters(2) Like "[AEIOUaeiou]"
'Unlikely but deals with "Oo" "ee" etc.
oRng.HighlightColorIndex = wdBlue
Case Else: oRng.HighlightColorIndex = wdYellow
End Select
End If
oRng.Collapse wdCollapseEnd
Wend
End With
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "[A-z]@[AEIOUaeiou]>"
.MatchWildcards = True
.Wrap = wdFindStop
While .Execute
If oRng.HighlightColorIndex = wdAuto Then
Select Case True
'Deal with compound words.
Case oRng.Words.First.Previous.Text = "-": oRng.MoveStart wdWord, -2
End Select
oRng.HighlightColorIndex = wdBrightGreen
oRng.Collapse wdCollapseEnd
End If
Wend
End With
lbl_Exit:
Exit Sub
End Sub