• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 810
  • Last Modified:

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

0
NAORC
Asked:
NAORC
  • 2
1 Solution
 
irudykCommented:
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

0
 
NAORCAuthor Commented:
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!
0
 
irudykCommented:
Hmm, okay well try modifying that section of the code to be:
    For Each rng In ActiveDocument.StoryRanges
        Select Case rng.Information(wdHeaderFooterType)
            Case 2, 3, 5    'range is in a footer section
                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
            Case Else
        End Select
    Next rng

Open in new window

0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now