HELP! Endless loop added 23,000 pages!

[Ed]

It's supposed to be a simple loop: find text, do this 'n that, find the next
one and do it again. But it doesn't find the next one - it keeps going back
to the first one! One of the commands is inserting a page break, so I've
got 23,000 new pages inserted before the first text string! How do I fix
this so it goes down and stops at the end of the document?

Ed

Sub sac2()



Dim oRg As Range

Set oRg = ActiveDocument.Range



With oRg.Find

.ClearFormatting

.Text = "ITEM ID"

.Forward = True ' this says "Search Forward Only", right?

.Format = False

.Wrap = wdFindStop ' this says "Stop at the End", right?

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False



Do While .Execute(FindText:="ITEM ID") = True

oRg.Words(1).Select



' Remove unwanted spaces to correctly position the text

Selection.MoveLeft Unit:=wdCharacter, Count:=1

Selection.HomeKey Unit:=wdLine, Extend:=wdExtend

Selection.Delete Unit:=wdCharacter, Count:=1

Selection.TypeText Text:=" "



' Add a page break before the text

Selection.HomeKey Unit:=wdLine

Selection.TypeParagraph

Selection.InsertBreak Type:=wdPageBreak

Selection.MoveDown Unit:=wdLine, Count:=2



Loop



End With



End Sub

 

[Jonathan West]

Hi Ed.

Just before the Loop command, include the following line

Selection.Collapse Direction:=wdCollapseEnd

 

[Ed]

Jonathan: I tried it, but it didn't work. I shrunk the VBE window on top
of my Word doc and stepped through the macro. It found the word, did its
stuff, put in the page break and moved down past it, then looped back *UP*
to the word it just used, did stuff and put in *ANOTHER* page break, and
went to loop again.

I don't claim to understand all of the "Collapse", but isn't it used when
something is still selected? By the time the code had put in a page break
and dropped down two lines, the orginal text to Find isn't selected any
more.

Ed

 

[JGM]

Hi Ed,

Here is a modified version of your code that did the trick for me... there
must be an easier way to accomplish this, but hey, it works!
'_______________________________________
Dim MyRange As Range

Set MyRange = ActiveDocument.Range

With MyRange.Find
.ClearFormatting
.Text = "123"
Do While .Execute(FindText:="ITEM ID", MatchCase:=False, _
MatchWholeWord:=False, MatchWildcards:=False, _
Forward:=True, Wrap:=wdFindStop, _
Format:=False) = True
With .Parent
.Select
MyRange.SetRange Selection.End + 1, _
ActiveDocument.Content.End
End With
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
'I had to comment out that line because it kept deleting the first
'character in ITEM ID as in my test ITEM ID was
'always at the beginning of a line...
' Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "

Selection.HomeKey Unit:=wdLine
Selection.TypeParagraph
Selection.InsertBreak Type:=wdPageBreak
Selection.MoveDown Unit:=wdLine, Count:=2
Loop
End With
'_______________________________________

HTH
Cheers!

 

[JGM]

Hi Ed,

Ooops!

Remove the
"+1"
in
MyRange.SetRange Selection.End + 1, _

It is not a big deal, but it is not necessary either...
It would skip an "ITEM ID" if it were right next to another one...

Cheers!

 

[Ed]

Thank you! I'll give it a shot. In looking over my original code, I think
one problem may be that the .Forward and .Wrap parameters are not included
in the loop. But as I kept messing with that, things just kept getting
worse!

Ed

 

[Haldun Alay]

Hi,

You need to re-assign new range to oRg variable after adding first paragraph. The code is (i think, because I'm not good in word vba) following.

before loop statement;

Set oRg = ActiveDocument.Range(Selection.Start, ActiveDocument.Range.End)


--
Regards

Haldun Alay

To e-mail me, please replace AT and DOT in my e-mail address with the original signs.



"Ed" <[email protected]>, iletide þunu yazdý It's supposed to be a simple loop: find text, do this 'n that, find the next
one and do it again. But it doesn't find the next one - it keeps going back
to the first one! One of the commands is inserting a page break, so I've
got 23,000 new pages inserted before the first text string! How do I fix
this so it goes down and stops at the end of the document?

Ed

Sub sac2()



Dim oRg As Range

Set oRg = ActiveDocument.Range



With oRg.Find

.ClearFormatting

.Text = "ITEM ID"

.Forward = True ' this says "Search Forward Only", right?

.Format = False

.Wrap = wdFindStop ' this says "Stop at the End", right?

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False



Do While .Execute(FindText:="ITEM ID") = True

oRg.Words(1).Select



' Remove unwanted spaces to correctly position the text

Selection.MoveLeft Unit:=wdCharacter, Count:=1

Selection.HomeKey Unit:=wdLine, Extend:=wdExtend

Selection.Delete Unit:=wdCharacter, Count:=1

Selection.TypeText Text:=" "



' Add a page break before the text

Selection.HomeKey Unit:=wdLine

Selection.TypeParagraph

Selection.InsertBreak Type:=wdPageBreak

Selection.MoveDown Unit:=wdLine, Count:=2



Loop



End With



End Sub