can't get out of loop

[Tony Logan]

I'm using a macro to add bookmarks to a document. I wrote the macro to find
each section break in the document, then look for the first alphanumeric
character and set a bookmark.

My problem is that whenever the macro reaches the end of the document, it
starts over at the beginning--the old infinite loop. I've tried the below
coding a couple of different ways--"Do" with Loop Until Selection.Find.Found
= False" and also "NextBookmark:" with "GoTo NextBookmark", but neither will
get me out of the loop.

I'm pretty certain the problem lies in the first instance of .Wrap =
wdFindContinue, but wdFindStop only works once, setting only one bookmark and
then kicking me out of the loop.

Any ideas how to modify this to kick me out of the loop when I reach the end
of the document? Here's the code:

Do
With Selection.Find
.Text = "^b" ' finds section break
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
'.Wrap = wdFindStop 'commented this after trying it; it didn't work
.Format = False
.MatchCase = True
.MatchWildcards = False
End With
Selection.Find.Execute

If Selection.Find.Found = True Then
With Selection
.Collapse (wdCollapseEnd)
Selection.Find.ClearFormatting
With Selection.Find
.Text = "[A-z0-9]" 'finds alphanumeric character
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWildcards = True
End With
Selection.Find.Execute
If Selection.Find.Found = True Then
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="bk" & intbk
.ShowHidden = False
End With
intbk = intbk + 1
Else: Exit Sub
End If
End With
End If
Loop Until Selection.Find.Found = False

 

[Peter]

Rather than using Selection.Find to find each Section Break, iterate through the ActiveDocument.Sections collection, finding the first instance of an alpha-numeric in each section:

Dim intbk As Integer
Dim oSection As Section
Dim oRange As Range

For Each oSection In ActiveDocument.Sections

Set oRange = oSection.Range

With oRange.Find
.Text = "[0-9,A-Z,a-z]"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
If .Execute Then
oRange.Font.Size = 28
intbk = intbk + 1
With ActiveDocument.Bookmarks
.Add Range:=oRange, Name:="bk" & intbk
.ShowHidden = False
End With
End If
End With

Next oSection


Tested in Word 2002

hth,

-Peter

 

[Tony Logan]

Hi, Peter. Your code worked for me, with only one caveat--I'm looking to have
it add the bookmarks only to a certain portion of the document, specifically
after text that says "Text appears below."

I tried modifying your code by selecting everything from the line break
after "Text appears below" until the end of the document, then adding
bookmarks to the selection. The code does this, but the one thing it does
wrong is add the first bookmark to the first instance of an alphanumeric
character in the document, instead of the selection.

After that it loops through the selection as intended, so if I know why the
first bookmark is getting added (incorrectly), I should be done.

Any suggestions? The code appears below. And thanks for your help, it was
most appreciated.

Dim intbk As Integer
Dim oSection As Section
Dim oRange As Range

intbk = 0

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Text appears below"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWildcards = False
End With
Selection.Find.Execute
Selection.EndKey Unit:=wdLine
Selection.EndKey Unit:=wdStory, Extend:=wdExtend

For Each oSection In Selection.Sections

Set oRange = oSection.Range

With oRange.Find
.Text = "[0-9,A-Z,a-z]"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
If .Execute Then
oRange.Font.Size = 28
intbk = intbk + 1
With Selection.Bookmarks
.Add Range:=oRange, Name:="bk" & intbk
.ShowHidden = False
End With
End If
End With

Next oSection

= = = = = = = = = = = = = = =

 

[Peter]

That's because part of the selection was still in the first section.

The following code will bookmark the first alpha-numeric character after "Text appears below", then the first alpha-numeric character of each section thereafter. If you don't want to bookmark the character right after "Text appears below", then meld the second If statement with the first using Else and it will bookmark the first alpha-numeric character in each section after the section containing "Text appears below".

Dim bFound As Boolean
Dim intbk As Integer
Dim oSection As Section
Dim oRange As Range

bFound = False
intbk = 0

For Each oSection In ActiveDocument.Sections

Set oRange = oSection.Range

If Not bFound Then
With oRange.Find
.Text = "Text appears below"
.MatchWildcards = False
.Wrap = wdFindStop
.Forward = True
If .Execute Then
bFound = True
Call oRange.Collapse(wdCollapseEnd)
End If
End With
End If

If bFound Then
With oRange.Find
.Text = "[0-9,A-Z,a-z]"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
If .Execute Then
oRange.Font.Size = 28
intbk = intbk + 1
With ActiveDocument.Bookmarks
.Add Range:=oRange, Name:="bk" & intbk
.ShowHidden = False
End With
End If
End With
End If
Next oSection

Set oRange = Nothing
Set oSection = Nothing


Don't forget to remove "oRange.Font.Size = 28" when you're done testing.

hth,

-Peter

Hi, Peter. Your code worked for me, with only one caveat--I'm looking to have
it add the bookmarks only to a certain portion of the document, specifically
after text that says "Text appears below."

I tried modifying your code by selecting everything from the line break
after "Text appears below" until the end of the document, then adding
bookmarks to the selection. The code does this, but the one thing it does
wrong is add the first bookmark to the first instance of an alphanumeric
character in the document, instead of the selection.

After that it loops through the selection as intended, so if I know why the
first bookmark is getting added (incorrectly), I should be done.

Any suggestions? The code appears below. And thanks for your help, it was
most appreciated.

Dim intbk As Integer
Dim oSection As Section
Dim oRange As Range

intbk = 0

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Text appears below"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWildcards = False
End With
Selection.Find.Execute
Selection.EndKey Unit:=wdLine
Selection.EndKey Unit:=wdStory, Extend:=wdExtend

For Each oSection In Selection.Sections

Set oRange = oSection.Range

With oRange.Find
.Text = "[0-9,A-Z,a-z]"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
If .Execute Then
oRange.Font.Size = 28
intbk = intbk + 1
With Selection.Bookmarks
.Add Range:=oRange, Name:="bk" & intbk
.ShowHidden = False
End With
End If
End With

Next oSection

= = = = = = = = = = = = = = =

Rather than using Selection.Find to find each Section Break, iterate through the ActiveDocument.Sections collection, finding the first instance of an alpha-numeric in each section:

Dim intbk As Integer
Dim oSection As Section
Dim oRange As Range

For Each oSection In ActiveDocument.Sections

Set oRange = oSection.Range

With oRange.Find
.Text = "[0-9,A-Z,a-z]"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
If .Execute Then
oRange.Font.Size = 28
intbk = intbk + 1
With ActiveDocument.Bookmarks
.Add Range:=oRange, Name:="bk" & intbk
.ShowHidden = False
End With
End If
End With

Next oSection


Tested in Word 2002

hth,

-Peter