Performing Repeated Actions Until End of Document is Reached

[USAFA]

I'm trying to find the text throughout a document and perform an action (go
to the beginning of the line & backspace 5 times) to take out space in my
document. After it does this I want it to continue performing these steps
(loop I guess) throughout the document, but I don't want it to stop once it
reaches the end of the document.

I need to use this macro on documents that range from 2 pages to 50 pages in
length. Please assist.

Here's my code so far:

Sub Step1()
Dim oRng As Range
Set oRng = ActiveDocument.Range
With Selection.Find
.Text = " ***************** PERSONAL"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute
Selection.HomeKey Unit:=wdLine
Selection.TypeBackspace
Selection.TypeBackspace
Selection.TypeBackspace
Selection.TypeBackspace
Selection.TypeBackspace
Selection.MoveRight Unit:=wdCharacter, Count:=6
Selection.EndKey Unit:=wdLine
End With
End Sub

 

[Ed]

A couple of questions:
your post title says
"Performing Repeated Actions Until End of Document is Reached"
while your post says

but I don't want it to stop once it
reaches the end of the document.

Do you want to stop when you reach the end of the document?
If not, then what is your criteria for stopping?

Also, it looks like you recorded the macro, then went back and set oRng as a
Range object. Once you've done that, you can use oRng.Find. One thing to
remember when using Find - if you use Selection, your selection is changed
to the found text; if you use a Range, your range is redefined to the found
text. In your case, oRng.Find would redefine your range from the entire doc
to just the found text. In some ways, this is good - Range objects can be
easier to work with.

For instance, if at the beginning of each loop you set a range equal to oRng
Set myRange = oRng
and used
myRange.Find
myRange would redefine itself to encompass just the found text. Then
myRange.Collapse Direction:=wdCollapseStart

myRange.Delete Unit:=wdCharacter, Count:=5
would delete the first five spaces and
myRange.Collapse Direction:=wdCollapseEnd
would take you back to the end of the found text.

HTH
Ed

 

[Greg Maxey]

USAFA,

Again, it seems to me that all you need is Find and Replace:

Sub Test()
Dim oRng As Range

Set oRng = ActiveDocument.Range

With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = " ***************** PERSONAL"
.Replacement.Text = "***************** PERSONAL"
assignments"
.Execute Replace:=wdReplaceAll

End With
End Sub

 

[Ed]

Yeah, Greg, that *is* a whole lot simpler than two ranges and looping and .
.. .
I keep hoping I'll learn one of these days! 8>/

Ed

 

[USAFA]

Greg & Ed,

Sorry for the confusion & thanks for the help. I actually DO want it to
stop performing the "find/move to line home/backspace 5x/move to line end"
actions once it reaches the end of the document. I had edited the macro code
using some info Greg provided, but I think I wasn't clear in getting across
my question.

To clarify, once I locate the text entitled " *****************
PERSONAL" then I am striking the HOME key to go to the beginning of the line.
Then I am deleting the 5 previous lines (not the spaces that precede the
***). So I'm not performing a replace action but rather a series of spacing
and move actions after I locate the text.

Thanks again.
USAFA

 

[Greg Maxey]

USAFA,

Try something like:


Sub ScratchMacro()
ActiveDocument.Range(0, 0).Select
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = " *****************PERSONAL"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
On Error Resume Next
Selection.Collapse Direction:=wdCollapseStart
Selection.MoveUp Unit:=wdLine, Count:=5
Selection.MoveDown Unit:=wdLine, Count:=5, Extend:=wdExtend
Selection.Delete
Selection.MoveEndUntil Cset:=vbCr, Count:=wdForward
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
If Selection.Range.End = ActiveDocument.Range.End Then
ActiveDocument.Range(0, 0).Select
Exit Sub
End If
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Collapse wdCollapseEnd
Loop
ActiveDocument.Range(0, 0).Select
End With

End Sub

P.S. Go Navy!!

 

[USAFA]

Greg,
I see what you're trying to do, but after copying it into a new macro &
running it, nothing happened. I'm stumped!

Thoughts?
USAFA

 

[Greg Maxey]

USAFA,

I just copied it to a new document and it worked fine. Do I have the spaces
and number of *'s right in the find string?

 

[USAFA]

Greg,

It finally worked. I can't tell you how much that helped me! Thanks again.

USAFA