Word VBA Find and move on

Question

Here is my issue, I'm looking for ":" and typing HTML code with VBA. The code below keeps looping at the same ":" and does not move on to the next, since I'm not actually removing it. Any suggestions?

Dim bFound As Boolean


bFound = True
Set r = ActiveDocument.Content

r.Find.ClearFormatting
Do While bFound
    With r.Find
        .Text = ":"
        .Replacement.Text = ":</b>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        bFound = .Execute(Replace:=wdReplaceOne, Forward:=True)
    End With

    If bFound Then
        r.Select
        Selection.HomeKey Unit:=wdLine
        Selection.TypeText Text:="<b>"
        Selection.EndKey Unit:=wdLine
        Selection.MoveRight
    End If
Loop

Answer 1

There are two issues with the code, which is otherwise quite good:

1. It uses wdFindContinue for the Wrap property, which means Find will restart at the beginning of the document. As a rule of thumb, always use wdFindStop in code.

2. It's necessary to move the found Range beyond that point if what's being searched remains in the document. This can be done by using Range.Collapse. Think of it like pressing the right-arrow key on the keyboard when you have a selection: it puts the cursor just beyond what was selected.

I've modified the original code with these two changes, plus I've declared a Rangevariable. That the original code ran without this declaration indicates Option Explicit may not be at the top of the code module. It's much better if it is there...

Sub JumpBeyondFound()
    Dim r As Word.Range
    Dim bFound As Boolean

    bFound = True
    Set r = ActiveDocument.content

    r.Find.ClearFormatting
    Do While bFound
        With r.Find
            .Text = ":"
            .Replacement.Text = ":</b>"
            .Forward = True
            .wrap = wdFindStop
            .Format = False
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            bFound = .Execute(Replace:=wdReplaceOne, Forward:=True)
        End With

        If bFound Then
            r.Select
            Selection.HomeKey Unit:=wdLine
            Selection.TypeText Text:="<b>"
            Selection.EndKey Unit:=wdLine
            Selection.MoveRight
            r.Collapse wdCollapseEnd
        End If
    Loop
End Sub