asked on

How do I write macro code to stop loop at end of document?

Greetings! I need help with a Word 2010 macro. I've recorded the macro below and it works fine once without a Do...Loop. However, when I include a Do...Loop, it runs through the document and when it gets to the last page, it goes into an infinite loop. I need to understand how to write a Do...Loop or Do...Until or Do...Loop Until macro that will stop at the end of the document.

My Word document is published out of a component content management system to Word, using a template to transform the data. The document layout is 2-column. At the beginning of each section, there is a Heading 1 (which I use to populate the header). Because I need to use before spacing for most styles, I need a way to make sure that all headings (at the beginning of a section OR the next heading at the top of column 2) start at the top of the column. I have also written a macro that handles all subsequent column breaks in a section by setting the Layout Options in the AutoOpen macro (works great).

I've written macros to handle the first heading at the top of column 1 for all sections. However, I'm struggling with getting the macro that I've written to handle the headings at the top of column 2. These headings are always preceeded by a column break. Here's what I've recorded:

Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .CorrectHangulEndings = True
        .HanjaPhoneticHangul = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute
    
    With Selection.Find
        .Text = "^n"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .CorrectHangulEndings = True
        .HanjaPhoneticHangul = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    With Selection.ParagraphFormat
        
        .SpaceBefore = 0
       
    End With

Open in new window

As I stated before, the above macro runs just fine once. If I wrap it up with a simple Do...Loop and step through the macro using F8, it does what I want it to do until I get to the last section of the document.

I understand that the macro lacks some sophistication, but I'm pretty new to the macro writing business.

I appreciate any help you can give me.

GrahamSkan

I always have problems understanding the objective with recorded macros.
However, I see that you have a couple of executes, so you could test to see if they find anything.

if Not Selection.Find.Execute then
exit do
endif

Open in new window

jbarcher13

ASKER

Thanks for the prompt reply. Help me out, though. Where do I put the If statement exactly?

For more information, here's what I want to do:

1. Search for Heading 1 style.
2. When found, then search for the first column break in that section.
3. When found, move the cursor right to the next line (which in this case will be a heading in column 2).
4. Format the paragraph with "0" spacing before (the styles can have either 12pts or 16pt space before and can be a number of different styles).
5. Do it again until I reach the end of the document.

Also, I can't just search for section breaks because I have quite a few in each section.

Thanks, jan

GrahamSkan

You have two lines such;
Selection.Find.Execute

Change them both to

If Not Selection.Find.Execute Then
    Exit Do
End I

Open in new window

jbarcher13

ASKER

Hi Graham!

Well, so far so good. Runs ok but gets hung up on the first End If toward the end of the doc. I've run this a couple of times and it has hung up in a couple of different places.

Here's the code that I've been running:

Option Explicit
Sub FixCo2Headings()
'
' Macro1 Macro
'

Do

    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .CorrectHangulEndings = True
        .HanjaPhoneticHangul = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    If Not Selection.Find.Execute Then
        Exit Do
    End If
    
    With Selection.Find
        .Text = "^n"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .CorrectHangulEndings = True
        .HanjaPhoneticHangul = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    If Not Selection.Find.Execute Then
        Exit Do
    End If
    
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    With Selection.ParagraphFormat
        
        .SpaceBefore = 0
       
    End With
Loop
  
End Sub

Open in new window

PS: I just tried to attach the Word doc for you, but somehow it's not working.

Thanks so much!

GrahamSkan

It can be a bit confusing attaching items. I'll have a go at reproducing the document from your description, but it might not be close enough.

Meanwhile I suggest that you persist with your attempts to post the document.

jbarcher13

ASKER

I just zipped up the Word doc and tried to upload, but this is the message I get:

The extension of one or more files in the archive is not in the list of allowed extensions: T107026 GS-30,GS-32,GS-46 Slab Scissor_63 [ANSICSA].docm

We use Word 2010, Macro-enabled documents. Is there something I can do to fix this and make it work for you?

OR can I send it to another email address?

Thanks! Jan

GrahamSkan

You could try saving it save it as a Word 2003 document - or perhaps make a copy and change the extension to .docx.

GrahamSkan

You probably don't need to send the code anyway. It's the text we need to see, so just save it as docx.

jbarcher13

ASKER

Hi Graham,

I've uploaded a zip file with the Word doc saved as a .docx, as well as the template in a .dot file format (since the site doesn't allow .dotm file formats).

Don't worry that this is in Chinese. The pages where the fixes need to happen are pags 13, 29, 52, 60, and 64.

Let me know what you find out, ok?

THANKS SO MUCH!! Jan
T107026-GS-30-GS-32-GS-46-Slab-S.zip
Genie-OM.dot

GrahamSkan

Sorry, I should have noticed it before.
Remove the lines:
.Wrap = wdFindContinue
This causes the search to restart at the beginning if the end of the document has been reached.

jbarcher13

ASKER

Hi Stefan,

If I get rid of both .Wrap = wdFindContinue lines (in both searches), nothing happens.

If I leave the first .Wrap statement and run the macro, it goes to Heading 1 on page 3 and stops.

If I run it again, it works. Then stops with Heading 1 on page three selected.

I'm confused. Why would it not work the first time I run it and then run the next time I run it.

I must be doing something wrong...

Thanks for bearing with me. I'm off for the weekend...hopefully you can help me solve this on Monday?

Did you get the files?

Thank you so much! Jan

GrahamSkan

Yes I have downloaded the files. It probably depends on where the Selection is before you start.
I'll try to have another look at it before Monday.

tdlewis

Recorded macros tend to include a lot of stuff you don't need.

The following code will look through the document (starting at the current cursor location) and change the spaceBefore for any Heading 1 that immediately follows a section break or a column break:

Dim selEnd As Long

    Selection.Find.ClearFormatting
    Selection.Find.style = ActiveDocument.Styles("Heading 1")
    Selection.Find.Format = True
    Selection.Find.text = ""
    Selection.Find.Execute
    Do While Selection.Find.found
        selEnd = Selection.End
        Selection.MoveLeft
        If Selection.text = Chr(14) Then ' Column Break
            Selection.MoveRight Unit:=wdCharacter, count:=1
            Selection.ParagraphFormat.spaceBefore = 0
        Else
            Selection.MoveLeft
            If Selection.text = vbFormFeed Then ' Section Break
                Selection.MoveRight Unit:=wdCharacter, count:=1
                Selection.ParagraphFormat.spaceBefore = 0
            End If
        End If
        Selection.SetRange selEnd, selEnd
        Selection.Find.Execute
    Loop

Open in new window

ASKER CERTIFIED SOLUTION

GrahamSkan

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

jbarcher13

ASKER

Hi Graham,

I brought the doc home (along with the template) and will try the solution this weekend!

I've read about ranges and have used other's code with ranges and am so glad you've used those. I'm so new to this that I just didn't know how to do two ranges.

I'll let you know what happens!

Again, thank you so much! Jan

jbarcher13

ASKER

Graham was awesome and responded to all my questions in a timely manner!

Thank you so much, Graham!!

jbarcher13

ASKER

Graham,

This worked beautifully! You rock! I have some more questions to post and hope to get the same kind of timely response from the experts.

Thank you again, Jan

GrahamSkan

Thank you, Jan. You made it a pleasure to help.