Word VBA, Infinite Loop with a find and replace

Hi, I'm wondering if someone would be kind enough to help me. I'm working
with a script and want to highlight different character names and their
dialogue. I can highlight the character names easily with Find and Replace.
But their subsequent dialogue, in a new paragraph under their character
names, is proving more difficult. I've created a macro that will do this,
but when it reaches the end of the script, it asks me if I want to continue
searching at the top of the document. If I say yes, it loops infinitely; if
I say no, it keeps asking again and again, another loop. Here's my code,
below. Any help is appreciated. Thanks.


Sub HighlightEllie()
'
' HighlightEllie Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
Options.DefaultHighlightColorIndex = wdYellow

With Selection.Find
.Text = "ELLIE^p"
.Replacement.Text = "ELLIE^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = True
End With


Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting

With Selection.Find
.Text = "ELLIE^p"
.Replacement.Text = "ELLIE^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = True
End With


Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting

Do While True

With Selection.Find
.Text = "ELLIE^p"
.Forward = True
.Wrap = wdFindAsk
.MatchCase = True
End With


Selection.Find.Execute


Selection.MoveDown Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdYellow
Selection.Range.HighlightColorIndex = wdYellow
Selection.HomeKey Unit:=wdLine

Loop


End Sub

Hi Kokomojo,

it looks to me as if you wanted to highlight "Ellie" at the end of
a paragraph and highlight the following paragraph, too.
If so, you don't need more than the following:

Sub Test5555()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "ELLIE^p"
While .Execute
rDcm.HighlightColorIndex = wdYellow
' prevent error if ELLIE is at the end of the last paragraph
If Not rDcm.Paragraphs(1).Next Is Nothing Then
rDcm.Paragraphs(1).Next.Range.HighlightColorIndex = wdYellow
End If
Wend
End With
End Sub

I think also, that
leads to an endless loop,
if the actual paragraph is the last paragraph in the doc.
Then
Selection.MoveDown has nothing to move to,
but doesn't error. It just does nothing.

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

Thanks Helmut, this worked like a charm!