asked on

Macro to Find & Replace Footer after section break

Ok, i've a very simple macro that asks for user input on various things (such as Client Name) and uses this to run a find and replace through my body text.

As part of the document i have a section Break after the 1st page, which has a footer, a section break after the second page, which has no footer and from there on in there is a consistent footer.

A simple find and replace does not check the footer and when i add the instruction WordBasic.ViewFooterOnly it only checks the 1st footer when i need it to check after the second section break...

All help appreciated!

'This is my basic user input & find and replace
 
sPrompt = "Please enter Client Name"
    sTitle = "Client"
    sDefault = "CLIENT PROPERTIES LTD"
    sClient = InputBox(sPrompt, sTitle, sDefault)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = """CLIENT"""
        .Replacement.Text = sClient
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
'This is where it should be checking the footer
 
sPrompt = "Please enter your Project Number"
    sTitle = "Project Number"
    sDefault = "Project Number"
    sPNo = InputBox(sPrompt, sTitle, sDefault)
    WordBasic.ViewFooterOnly
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = """Proj No"""
        .Replacement.Text = sPNo
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Open in new window

irudyk

Try something like the following:

'This is my basic user input & find and replace
 
sPrompt = "Please enter Client Name"
    sTitle = "Client"
    sDefault = "CLIENT PROPERTIES LTD"
    sClient = InputBox(sPrompt, sTitle, sDefault)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = """CLIENT"""
        .Replacement.Text = sClient
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
 
'This is where it should be checking the footer
Dim rng As Range
 
sPrompt = "Please enter your Project Number"
    sTitle = "Project Number"
    sDefault = "Project Number"
    sPNo = InputBox(sPrompt, sTitle, sDefault)
    For Each rng In ActiveDocument.StoryRanges
        Do
            With rng.Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Text = """Proj No"""
                .Replacement.Text = sPNo
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Execute Replace:=wdReplaceAll
            End With
            Set rng = rng.NextStoryRange
        Loop Until rng Is Nothing
    Next rng

Open in new window

NAORC

ASKER

Irudyk,

Thanks - Not to sound ungrateful, but while this solves the problem it takes about 2 minutes to run that section of the code. It's only a 14 page document (Office 2007). Any ideas on how it can be sped up at all?

Thanks!

ASKER CERTIFIED SOLUTION

irudyk

membership

This solution is only available to members.

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

Start Free Trial

Macro to Find &amp; Replace Footer after section break

Macro to Find & Replace Footer after section break