Helmut,

Yep.  As usual typos abound on my end.

Very nice to get your input!
Am new to discussion group and not yet entirely clear on protocals.
I posted reply to Jean-Guy Marcil (1st responder) with additional questions.
If you have time your input would be valued.
Thanks again
Frank

I forgot to mention that by using that method, you advance to the next word
by pressing the enter key. The button would be the default button and its
code would just be: Unload Me

Russ,

I was too far into my own crude solution to back up and take a hard look at
yours.  Perhaps if this was a process that "I" really needed I might give if
the extra effort.

I have scratched together some crude code that appears to do what I
understood the OP requested:

'Run from Menu, hotkey or toobar
Sub RunMan()
ReadWords False
End Sub

'Run from Menu, hotkey or toobar
Sub RunAuto()
ReadWords True
End Sub

Sub ReadWords(ByRef bTest As Boolean)
Dim oRng As Word.Range
Dim wdsDoc As Words
Dim i As Long
Dim strPause As String
Dim bAutoTimed As Boolean
Dim pRng As Word.Range

Set oRng = ActiveDocument.Range
oRng.Start = Selection.Range.Start
bAutoTimed = bTest
Set wdsDoc = oRng.Words
If bAutoTimed Then
 Do
   strPause = InputBox("How long would you like to wait for each word?",
"Set Timer ")
 Loop While Not IsNumeric(strPause)
 For i = 1 To wdsDoc.Count
   With wdsDoc(i)
     If Not .Characters(1) Like "[!A-Za-z]" Then
       wdsDoc.Item(i).Select
       ActiveWindow.ScrollIntoView Selection.Range, True
       Selection.Collapse wdCollapseEnd
       .HighlightColorIndex = wdYellow
       .Bold = True
       .Font.Size = .Font.Size + 6
       Application.ScreenRefresh
       WaitABit CSng(strPause)
       DoEvents
       ActiveDocument.UndoClear
       Application.ScreenRefresh
       .HighlightColorIndex = wdNoHighlight
       .Bold = False
       .Font.Size = .Font.Size - 6
     End If
   End With
 Next
Else
 For i = 1 To wdsDoc.Count
   With wdsDoc(i)
     If Not .Characters(1) Like "[!A-Za-z]" Then
     .Select
     Exit For
     End If
   End With
 Next
 On Error GoTo Err_Handler
 Set pRng = wdsDoc(i)
 pRng.Start = ActiveDocument.Range.Start
 With pRng.Find
   .Font.Bold = True
   .Highlight = True
   .Font.Size = Selection.Font.Size + 6
   While .Execute
     With pRng
       If .HighlightColorIndex = wdYellow Then
         .Font.Bold = False
         .HighlightColorIndex = wdNoHighlight
         .Font.Size = .Font.Size - 6
       End If
     End With
   Wend
 End With
 ActiveWindow.ScrollIntoView Selection.Range, True
 With wdsDoc(i)
   .HighlightColorIndex = wdYellow
   .Font.Bold = True
   .Font.Size = Selection.Font.Size + 6
   .Collapse wdCollapseEnd
 End With
 Selection.Collapse wdCollapseEnd
 Application.ScreenRefresh
End If
Exit Sub
Err_Handler:
'When there are no more valid words an error will occur. _
'Now need to figure out how to clean up last highlighted word.
End Sub

Sub WaitABit(sngWaitSecs As Single)
Dim myDate As Date
myDate = Timer
Do
Loop Until (Timer - myDate) > sngWaitSecs
End Sub

One nagging issue remains.  When stepping through manually went there are no
more valid words the code will throw and error (a good thing).  I need to
figure out how to clear the special formatting on the last word processed.

I am done for now but would be interested in what others might do with this.