?
Solved

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

Posted on 2012-09-14
18
Medium Priority
?
3,576 Views
Last Modified: 2012-09-16
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.
0
Comment
Question by:jbarcher13
  • 9
  • 8
18 Comments
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 38399054
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

0
 

Author Comment

by:jbarcher13
ID: 38399130
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
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 38399159
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

f
0
NEW Veeam Backup for Microsoft Office 365 1.5

With Office 365, it’s your data and your responsibility to protect it. NEW Veeam Backup for Microsoft Office 365 eliminates the risk of losing access to your Office 365 data.

 

Author Comment

by:jbarcher13
ID: 38399420
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!
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 38399753
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.
0
 

Author Comment

by:jbarcher13
ID: 38399804
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
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 38400131
You could try saving it save it as a Word 2003 document - or perhaps make a copy and change the extension to .docx.
0
 
LVL 76

Expert Comment

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

Author Comment

by:jbarcher13
ID: 38400212
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
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 38400335
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.
0
 

Author Comment

by:jbarcher13
ID: 38400425
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
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 38400716
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.
0
 
LVL 10

Expert Comment

by:tdlewis
ID: 38401024
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

0
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 2000 total points
ID: 38401608
This code uses ranges (which are faster) and works on the whole of the document. It does stop at the end of the document.
Sub FixCo2HeadingsRng()
    Dim rng1 As Range
    Dim rng2 As Range
    
    Set rng1 = ActiveDocument.Range 'Set rng to whole of document body range
    With rng1.Find
        .Style = ActiveDocument.Styles("Heading 1")
        .CorrectHangulEndings = True 'not sure if two settings
        .HanjaPhoneticHangul = False 'are relevant
        Do While .Execute
            DoEvents 'allow other processes to have some CPU time
            Set rng2 = ActiveDocument.Range
            rng2.Start = rng1.End 'set rng2 to cover the rest of the document
            With rng2.Find
                .Text = "^n" 'column break
                .CorrectHangulEndings = True
                .HanjaPhoneticHangul = False
                If .Execute Then
                    rng2.Collapse wdCollapseEnd
                    rng2.Move wdCharacter, 1 'now in next paragraph
                    rng2.Paragraphs.First.SpaceBefore = 0
                Else
                    Exit Do 'no more column breaks
                End If
            End With
        Loop 'until last "Heading 1" paragraph
    End With
  
End Sub

Open in new window

0
 

Author Comment

by:jbarcher13
ID: 38401749
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
0
 

Author Closing Comment

by:jbarcher13
ID: 38403172
Graham was awesome and responded to all my questions in a timely manner!

Thank you so much, Graham!!
0
 

Author Comment

by:jbarcher13
ID: 38403173
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
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 38403179
Thank you, Jan. You made it a pleasure to help.
0

Featured Post

Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This collection of functions covers all the normal rounding methods of just about any numeric value.
Article by: Leon
Software Metering within our group of companies has always been an afterthought until auditing of software and licensing became a pain point. Orchestrator and SCCM metering gave us the answer and it was an exciting process.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

864 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question