Stuck in an infinite While loop inside a find function

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.

Code:

---

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

---

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

Code:

---

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

---

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.

Not the best most applicable answer, but it will work

Code:

---

Do While
i = i + 1
DoStuff
If 1 >= 1000 Then Exit Do
Loop

---

That is covering up the real problem

Code:

---

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

---

Quote:

---

Originally Posted by gmaxey

Code:

---

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.

This might help:

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

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