Find with "While .Found" loop isn't moving to next found item

B

Benjamino5

Below is the code. I'm trying to find every instance of the character style
"Index" in the document and insert an XE (Index) field in each case.

What's happening is that the "While .Found" loop finds the first item, then
finds it again, and again, etc., and I end up with many identical XE fields
added to that first item.

I think the problem must be redefining "r" somehow by using it in the
MarkEntries line, but I'm not sure, and I'm not sure how to fix it.

Thanks!
Ben

__________________________________

Sub MarkEntries(adoc As Document)
' finds every instance of the character style
' "Index" and marks it with an XE field
Dim f As Find
Dim r As Range
Set r = adoc.Range
Set f = r.Find
With f
.Format = True
.Style = "Index"
.Forward = True
.Wrap = wdFindStop
.Execute
End With
While f.Found
adoc.Indexes.MarkEntry Range:=r, Entry:=r.Text
f.Execute
Wend
End Sub
 
D

Doug Robbins - Word MVP

The following code shows how to use a Do While Found loop. You may need to
change the .Wrap parameter to suit your case.

Dim myrange As Range
Dim myoptions As Variant
Dim ffield As FormField

Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="] [", Forward:=True, MatchWildcards:=False,
Wrap:=wdFindStop) = True
Set myrange = Selection.Paragraphs(1).Range
myrange.start = myrange.start + InStr(myrange, "[")
myrange.End = myrange.start + InStrRev(myrange, "]") - 1
myoptions = Split(myrange, "] [")
myrange.start = myrange.start - 1
myrange.End = myrange.End + 1
Set ffield = ActiveDocument.FormFields.Add(Range:=myrange,
Type:=wdFieldFormDropDown)
With ffield
For i = LBound(myoptions) To UBound(myoptions)
.DropDown.ListEntries.Add myoptions(i)
Next i
.Range.InsertBefore " "
End With
Loop
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
B

Benjamino5

Doug,

Thank you for the help, but I'm afraid I'm still a bit lost. Taking your
code and adapting it for me, I found I need to change the line:

Set myrange = Selection.Paragraphs(1).Range

and change it to:

Set myrange = Selection.Range

because I need to capture the whole range found by the Find object. But when
I make that change to your code (leaving everything else the same), it gets
stuck on the same range over and over.

I'm afraid I'm not familiar with the Find object. Any further tips from
anyone?

Thanks again,
Ben

Doug Robbins - Word MVP said:
The following code shows how to use a Do While Found loop. You may need to
change the .Wrap parameter to suit your case.

Dim myrange As Range
Dim myoptions As Variant
Dim ffield As FormField

Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="] [", Forward:=True, MatchWildcards:=False,
Wrap:=wdFindStop) = True
Set myrange = Selection.Paragraphs(1).Range
myrange.start = myrange.start + InStr(myrange, "[")
myrange.End = myrange.start + InStrRev(myrange, "]") - 1
myoptions = Split(myrange, "] [")
myrange.start = myrange.start - 1
myrange.End = myrange.End + 1
Set ffield = ActiveDocument.FormFields.Add(Range:=myrange,
Type:=wdFieldFormDropDown)
With ffield
For i = LBound(myoptions) To UBound(myoptions)
.DropDown.ListEntries.Add myoptions(i)
Next i
.Range.InsertBefore " "
End With
Loop
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Benjamino5 said:
Below is the code. I'm trying to find every instance of the character
style
"Index" in the document and insert an XE (Index) field in each case.

What's happening is that the "While .Found" loop finds the first item,
then
finds it again, and again, etc., and I end up with many identical XE
fields
added to that first item.

I think the problem must be redefining "r" somehow by using it in the
MarkEntries line, but I'm not sure, and I'm not sure how to fix it.

Thanks!
Ben

__________________________________

Sub MarkEntries(adoc As Document)
' finds every instance of the character style
' "Index" and marks it with an XE field
Dim f As Find
Dim r As Range
Set r = adoc.Range
Set f = r.Find
With f
.Format = True
.Style = "Index"
.Forward = True
.Wrap = wdFindStop
.Execute
End With
While f.Found
adoc.Indexes.MarkEntry Range:=r, Entry:=r.Text
f.Execute
Wend
End Sub
 
D

Doug Robbins - Word MVP

You probably need to include a

Selection.Collapse wdCollapseEnd

to move the selection point.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Benjamino5 said:
Doug,

Thank you for the help, but I'm afraid I'm still a bit lost. Taking your
code and adapting it for me, I found I need to change the line:

Set myrange = Selection.Paragraphs(1).Range

and change it to:

Set myrange = Selection.Range

because I need to capture the whole range found by the Find object. But
when
I make that change to your code (leaving everything else the same), it
gets
stuck on the same range over and over.

I'm afraid I'm not familiar with the Find object. Any further tips from
anyone?

Thanks again,
Ben

Doug Robbins - Word MVP said:
The following code shows how to use a Do While Found loop. You may need
to
change the .Wrap parameter to suit your case.

Dim myrange As Range
Dim myoptions As Variant
Dim ffield As FormField

Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="] [", Forward:=True,
MatchWildcards:=False,
Wrap:=wdFindStop) = True
Set myrange = Selection.Paragraphs(1).Range
myrange.start = myrange.start + InStr(myrange, "[")
myrange.End = myrange.start + InStrRev(myrange, "]") - 1
myoptions = Split(myrange, "] [")
myrange.start = myrange.start - 1
myrange.End = myrange.End + 1
Set ffield = ActiveDocument.FormFields.Add(Range:=myrange,
Type:=wdFieldFormDropDown)
With ffield
For i = LBound(myoptions) To UBound(myoptions)
.DropDown.ListEntries.Add myoptions(i)
Next i
.Range.InsertBefore " "
End With
Loop
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Benjamino5 said:
Below is the code. I'm trying to find every instance of the character
style
"Index" in the document and insert an XE (Index) field in each case.

What's happening is that the "While .Found" loop finds the first item,
then
finds it again, and again, etc., and I end up with many identical XE
fields
added to that first item.

I think the problem must be redefining "r" somehow by using it in the
MarkEntries line, but I'm not sure, and I'm not sure how to fix it.

Thanks!
Ben

__________________________________

Sub MarkEntries(adoc As Document)
' finds every instance of the character style
' "Index" and marks it with an XE field
Dim f As Find
Dim r As Range
Set r = adoc.Range
Set f = r.Find
With f
.Format = True
.Style = "Index"
.Forward = True
.Wrap = wdFindStop
.Execute
End With
While f.Found
adoc.Indexes.MarkEntry Range:=r, Entry:=r.Text
f.Execute
Wend
End Sub
 
B

Benjamino5

Doug,

Thanks! It turned out to involve a little bit more, because collapsing the
selection put the cursor in front of the XE field, not after it, but I turned
off ShowAll and explicitly moved the Selection.Start over and it got the job
done.

I appreciate your code samples and advice.

Ben

Doug Robbins - Word MVP said:
You probably need to include a

Selection.Collapse wdCollapseEnd

to move the selection point.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Benjamino5 said:
Doug,

Thank you for the help, but I'm afraid I'm still a bit lost. Taking your
code and adapting it for me, I found I need to change the line:

Set myrange = Selection.Paragraphs(1).Range

and change it to:

Set myrange = Selection.Range

because I need to capture the whole range found by the Find object. But
when
I make that change to your code (leaving everything else the same), it
gets
stuck on the same range over and over.

I'm afraid I'm not familiar with the Find object. Any further tips from
anyone?

Thanks again,
Ben

Doug Robbins - Word MVP said:
The following code shows how to use a Do While Found loop. You may need
to
change the .Wrap parameter to suit your case.

Dim myrange As Range
Dim myoptions As Variant
Dim ffield As FormField

Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="] [", Forward:=True,
MatchWildcards:=False,
Wrap:=wdFindStop) = True
Set myrange = Selection.Paragraphs(1).Range
myrange.start = myrange.start + InStr(myrange, "[")
myrange.End = myrange.start + InStrRev(myrange, "]") - 1
myoptions = Split(myrange, "] [")
myrange.start = myrange.start - 1
myrange.End = myrange.End + 1
Set ffield = ActiveDocument.FormFields.Add(Range:=myrange,
Type:=wdFieldFormDropDown)
With ffield
For i = LBound(myoptions) To UBound(myoptions)
.DropDown.ListEntries.Add myoptions(i)
Next i
.Range.InsertBefore " "
End With
Loop
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Below is the code. I'm trying to find every instance of the character
style
"Index" in the document and insert an XE (Index) field in each case.

What's happening is that the "While .Found" loop finds the first item,
then
finds it again, and again, etc., and I end up with many identical XE
fields
added to that first item.

I think the problem must be redefining "r" somehow by using it in the
MarkEntries line, but I'm not sure, and I'm not sure how to fix it.

Thanks!
Ben

__________________________________

Sub MarkEntries(adoc As Document)
' finds every instance of the character style
' "Index" and marks it with an XE field
Dim f As Find
Dim r As Range
Set r = adoc.Range
Set f = r.Find
With f
.Format = True
.Style = "Index"
.Forward = True
.Wrap = wdFindStop
.Execute
End With
While f.Found
adoc.Indexes.MarkEntry Range:=r, Entry:=r.Text
f.Execute
Wend
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top