vba - Why is range.find searching like this?

Question

I am trying to search for occurrences of a particular string in a Word document. The code should search only after the Table of Contents. My completed code is below:

Private Sub cmdFindNextAbbr_Click()

    Dim myRange As range

    'CREATING DICTONARY for Selected Items
    If firstClickAbr = True Then

        txtNew = ""

        abSelIndex = 0
        Set abSel = CreateObject("scripting.dictionary")
        Set abSelFirstStart = CreateObject("scripting.dictionary")

        firstClickAbr = False
        iAbbr = 0
        For x = 0 To lstAbbreviations.ListCount - 1
            If lstAbbreviations.Selected(x) = True Then
                If Not abSel.Exists(lstAbbreviations.List(x, 1)) Then
                    abSel.Add lstAbbreviations.List(x, 0), lstAbbreviations.List(x, 1)
                    abSelFirstStart.Add lstAbbreviations.List(x, 0), lstAbbreviations.List(x, 5)
                End If
            End If
        Next x
    End If

    Dim Word, findText As String
    Dim chkAbbrLast, fsCountExt, firstOccEnd As Integer

    Do While abSelIndex < abSel.count
        chkAbbrLast = 0

        Set myRange = ActiveDocument.Content

        If txtNew <> abSel.keys()(abSelIndex) Then
            fnCountAbr = 0
            locInteger = abbrTableEnd
        End If

        firstOccEnd = abSelFirstStart.items()(abSelIndex) + Len(abSel.items()(abSelIndex) & " (" & abSel.keys()(abSelIndex) & ")")
        fnCountAbr = fnCountAbr + 1
        Word = abSel.keys()(abSelIndex)

        'initially search for full text
        findText = abSel.items()(abSelIndex)

        myRange.Start = locInteger
        myRange.Find.ClearFormatting
        Do While myRange.Find.Execute( _
                    findText:=findText, _
                    MatchCase:=False, _
                    MatchWholeWord:=True, _
                    Wrap:=wdFindStop, _
                    Forward:=True _
                    )

            If Left(myRange.Style, 7) <> "Heading" Then
                If abSelFirstStart.items()(abSelIndex) <> myRange.Start Then 'ignore the first occurrence

                    locInteger = myRange.End
                    tCount = tCount + 1

                    'check for full term and abbreviation
                    fsCountExt = Len(abSel.items()(abSelIndex) & "s (" & abSel.keys()(abSelIndex) & "s)")
                    myRange.End = myRange.Start + fsCountExt

                    If InStr(UCase(myRange.Text), UCase(abSel.items()(abSelIndex) & "s (" & abSel.keys()(abSelIndex) & "s)")) > 0 Then
                        txtNew = abSel.keys()(abSelIndex) & "s"
                        myRange.Select
                        Exit Sub
                    Else
                        fsCountExt = Len(abSel.items()(abSelIndex) & " (" & abSel.keys()(abSelIndex) & ")")
                        myRange.End = myRange.Start + fsCountExt
                    End If

                    If InStr(UCase(myRange.Text), UCase(abSel.items()(abSelIndex) & " (" & abSel.keys()(abSelIndex) & ")")) > 0 Then
                        txtNew = abSel.keys()(abSelIndex)
                        myRange.Select
                        Exit Sub
                    End If

                    'check for full term only
                    fsCountExt = Len(abSel.items()(abSelIndex) & "s (" & abSel.keys()(abSelIndex) & "s)")
                    myRange.End = myRange.Start + fsCountExt

                    If InStr(UCase(myRange.Text), UCase(abSel.items()(abSelIndex) & "s")) > 0 Then
                        txtNew = abSel.keys()(abSelIndex) & "s"
                        myRange.Select
                        Exit Sub
                    Else
                        fsCountExt = Len(abSel.items()(abSelIndex))
                        myRange.End = myRange.Start + fsCountExt
                    End If

                    If InStr(UCase(myRange.Text), UCase(abSel.items()(abSelIndex))) > 0 Then
                        txtNew = abSel.keys()(abSelIndex)
                        myRange.Select
                        Exit Sub
                    End If
                End If
            End If
                chkAbbrLast = chkAbbrLast + 1     ' check to prevent infinite loop
            myRange.End = ActiveDocument.Content.End
            If chkAbbrLast > 2 Then
                Exit Do
            End If
        Loop

        'now search for abbreviation
        findText = abSel.keys()(abSelIndex)
        chkAbbrLast = 0
        myRange.Start = locInteger
        myRange.Find.ClearFormatting
        Do While myRange.Find.Execute( _
                    findText:=findText, _
                    MatchCase:=True, _
                    MatchWholeWord:=True _
                    )

            If Left(myRange.Style, 7) <> "Heading" And myRange.Start > firstOccEnd Then

                If abbIgnoreList.contains(myRange.Start) Then ' skip if match is in ignore list
                    If abSelIndex = abSel.count - 1 Then
                        chkAbbrLast = chkAbbrLast + 1   ' check to prevent infinite loop
                    End If
                    locInteger = myRange.End
                Else
                    locInteger = myRange.End
                    tCount = tCount + 1

                    fsCountExt = Len(abSel.keys()(abSelIndex) & "s")
                    myRange.End = myRange.Start + fsCountExt

                    If InStr(UCase(myRange.Text), UCase(abSel.keys()(abSelIndex) & "s")) > 0 Then
                        txtNew = abSel.keys()(abSelIndex) & "s"
                        myRange.Select
                        Exit Sub
                    Else
                        fsCountExt = Len(abSel.keys()(abSelIndex))
                        myRange.End = myRange.Start + fsCountExt
                    End If

                    If InStr(UCase(myRange.Text), UCase(abSel.keys()(abSelIndex))) > 0 Then
                        txtNew = abSel.keys()(abSelIndex)
                        myRange.Select
                        Exit Sub
                    End If
                End If

            End If
                chkAbbrLast = chkAbbrLast + 1     ' check to prevent infinite loop
            If chkAbbrLast > 2 Then
                Exit Do
            End If
            myRange.End = ActiveDocument.Content.End

        Loop

        'loop to next/first item
        If abSelIndex <= abSel.count - 1 Then
            abSelIndex = abSelIndex + 1
        Else
            abSelIndex = 0 ' start again at beginning
        End If
    Loop

    MsgBox "No further occurrences found"
End Sub

ToCEnd is 4085.

I am able to find the first result. When I click on a find next button, which calls the same method, I have the below values:

myRange.Start : 18046
myRange.End : 21467

However, after .Find.Execute, I have the below values:

myRange.Start : 18022
myRange.End : 18046 

Why does the found text end at the start point I had defined earlier? The difference between Start and End is the length of my string, 24

EDIT: I have added the complete code.

What I am doing in the code is finding the text that the user may replace. The replace is triggered from another button.

In the Find Next button event, I validate a result, store the end of the range to a variable and exit the sub. On the next click, I am trying to search from the stored location onward.

I updated my code to be like the one at this link, still I have the same behavior.

Answer 1

You apparently want to loop through the found instances. For that you could use code like:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = InputBox("What is the Text to Find")
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = i + 1
    'insert code to do something with whatever's been found here
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub