Stuck in an infinite While loop inside a find function

[MialLewis]

Hi all,

Hoping you can solve my problem... I've spent hours looking for a solution and still no luck.

I'm using the latest version of word via Office 365.

I am writing a program that will search through a document using a list of words (I haven't put this feature in yet, its just searching for a static term) and will highlight the first occurrence one colour, and the subsequent occurrences another. The code fulfills this function, but won't end as it is stuck in a while loop. I have no idea why, the logic is find to my understanding. Can anyone shed any light upon why this is happening?

Thanks in advance, code is below.



Sub Highlight()

'Application.ScreenUpdating = False 'Turn off updating for speed


Set SearchRange = ActiveDocument.Content 'Set Range to search


Options.DefaultHighlightColorIndex = wdYellow


Dim A As String 'Introduce variable for Words


'Loop will start here (not introduced yet)


With SearchRange.Find
.Text = "TEST"
.Replacement.Text = "TEST"
.Replacement.Highlight = True 'Highlight
.MatchWholeWord = True
.MatchCase = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindEnd
.MatchWildcards = False

Do While .Execute(Replace:=wdReplaceOne)

Options.DefaultHighlightColorIndex = wdTeal

Loop

End With


Options.DefaultHighlightColorIndex = wdYellow


'Loop will end here (not introduced yet)


'Application.ScreenUpdating = True


End Sub

[Kilroy]

This will change the first occurrence of a highlighted word from yellow to teal. Not sure how to add specific text (Test).


Sub SearchAnyHighlight()
Dim hiliRng As Range
Set hiliRng = ActiveDocument.Content
With hiliRng.Find
.Highlight = True
.Execute
.Wrap = wdFindEnd
hiliRng.Find.Execute
If hiliRng.HighlightColorIndex = wdYellow Then
hiliRng.HighlightColorIndex = wdTeal
Selection.Find.Execute Replace:=wdFindEnd
End If
End With
End Sub

[MialLewis]

Hi, thanks for your reply. The code already performs the function I want it to. It searches through the whole document (not just highlighted words), highlights the first word in yellow, continues searching and highlights the rest in teal. Sorry it that wasn't clear enough. I could run that code after the end of a previous find loop, but didn't want to do that for efficiency reasons.

Problem is, it reaches the end of the search range, then just gets stuck in the while loop, seemingly not doing anything. Doesn't go back to the start of the document to search through the range again either, tested for that.

[SamT]

Not the best most applicable answer, but it will work

Do While
i = i + 1
DoStuff
If 1 >= 1000 Then Exit Do
Loop
That is covering up the real problem

[gmaxey]

Sub Highlight()
Dim oRng As Range
Dim A() As String 'Introduce variable for Words
Dim lngIndex As Long
A = Split("TEST,dog,cat,boy", ",")
For lngIndex = 0 To UBound(A)
Set oRng = ActiveDocument.Content 'Set Range to search
Options.DefaultHighlightColorIndex = wdYellow
With oRng.Find
.Text = A(lngIndex)
'.Replacement.Text = "TEST"
.Replacement.Highlight = True 'Highlight
.MatchWholeWord = True
.MatchCase = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindStop
.MatchWildcards = False
Do While .Execute(Replace:=wdReplaceOne)
Options.DefaultHighlightColorIndex = wdTeal
oRng.Collapse wdCollapseEnd
Loop
End With
Options.DefaultHighlightColorIndex = wdYellow
Next lngIndex
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub

[MialLewis]

Sub Highlight()
Dim oRng As Range
Dim A() As String 'Introduce variable for Words
Dim lngIndex As Long
A = Split("TEST,dog,cat,boy", ",")
For lngIndex = 0 To UBound(A)
Set oRng = ActiveDocument.Content 'Set Range to search
Options.DefaultHighlightColorIndex = wdYellow
With oRng.Find
.Text = A(lngIndex)
'.Replacement.Text = "TEST"
.Replacement.Highlight = True 'Highlight
.MatchWholeWord = True
.MatchCase = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindStop
.MatchWildcards = False
Do While .Execute(Replace:=wdReplaceOne)
Options.DefaultHighlightColorIndex = wdTeal
oRng.Collapse wdCollapseEnd
Loop
End With
Options.DefaultHighlightColorIndex = wdYellow
Next lngIndex
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub



This is the one! The line 'oRng.Collapse wdCollapseEnd' solved the issue without dodgy workaround. Thanks for all the responses though.

Any idea why this works? I can't get my head around the logic.

[gmaxey]

This might help:

http://gregmaxey.com/word_tip_pages/words_fickle_vba_find_property.html

You could have also used:
.Text = A(lngIndex)
.Highlight = False