Why is range.find searching like this? - vba

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