Find-replace array macro in story ranges?

Question

Hi, I use the following array macro for executing multiple find-and-replace searches:

Set activeRng = ActiveDocument.Range

Dim wsFindArray(2) As String

Dim wsReplaceArray(2) As String

Dim i As Long

wsFindArray(1) = "TK"

wsFindArray(2) = "TK"

wsReplaceArray(1) = "TK"

wsReplaceArray(2) = "TK"

For i = 1 To UBound(wsFindArray)

With activeRng.Find

 .Text = wsFindArray(i)

With .Replacement

 .Text = wsReplaceArray(i)

End With

 .Execute Replace:=wdReplaceAll, Wrap = wdFindContinue

End With

Next

End Sub

I'd really like to modify it so that it works through both the main text and the endnotes story range. Any suggestions on how to do that? I've looked at the coding here ...

http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm

... and I'm not sure how to combine it with my array macro (or if they can be combined at all). I'd appreciate your help.

Answer 1

OK, I wrote this quick cleanup macro, and it's not working. Any ideas where I went wrong with the coding?

Dim myStoryRange As Range, i As Long, _

ArrFnd(3) As Variant, ArrRep(3) As Variant

ArrFnd(1) = " {2,}" 'multiple spaces = 1

ArrRep(1) = " "

ArrFnd(2) = " ^13" 'leading space, return

ArrRep(2) = "^p"

ArrFnd(3) = "^13 " 'trailing space, return

ArrRep(3) = "^p"

For Each myStoryRange In ActiveDocument.StoryRanges

With myStoryRange.Find

  .ClearFormatting

  .Replacement.ClearFormatting

  .Forward = True

  .Wrap = wdFindContinue

  .Format = False

  .MatchWildcards = True

For i = 1 To UBound(ArrRep)

 .Text = ArrFnd(i)

 .Replacement.Text = ArrRep(i)

 .Execute Replace:=wdReplaceAll

Next i

End With

Next myStoryRange

End Sub

Answer 2

Great, thanks. I'm going to use the third version, which I've adapted as follows:

Dim i As Long, ArrFnd(2) As Variant, ArrRep(2) As Variant

ArrFnd(1) = "Findterm1"

ArrRep(1) = "Replaceterm1"

ArrFnd(2) = "Findterm2"

ArrRep(2) = "Replaceterm2"

For Each myStoryRange In ActiveDocument.StoryRanges

With myStoryRange.Find

  .ClearFormatting

  .Replacement.ClearFormatting

  .Forward = True

  .Wrap = wdFindContinue

For i = 1 To UBound(ArrRep)

 .Text = ArrFnd(i)

 .Replacement.Text = ArrRep(i)

 .Execute Replace:=wdReplaceAll

Next i

End With

Next myStoryRange

End Sub

I want the changes to apply in both the main text and endnotes, and in my case,  there are no headers, footers, comments, or text boxes. So setting it to run through all story ranges works best.

Answer 3

A few notes/questions:

• I got an error in FndRepRng on the array declarations. After I took out the "Const," it worked no problem.
• I guess because endnotes are automatically linked, it doesn't seem necessary to test each one to see if it's linked to the previous note. But with your macro, we've got a horizontal structure:

Const ArrFnd = Array("Findterm1", "Findterm2")

Const ArrRep = Array("Replaceterm1", "Replaceterm2")

This could get cumbersome. Is there any way to incorporate the vertical list approach in your macro?

Code fixed.

Endnotes are not linked - the part of the code you're referring to applies to headers and footers only.

If all you want to do is replace endnote text, you could use any of the following approaches:

Sub EndnoteFndRep1()

Dim i As Long, ArrFnd As Variant, ArrRep As Variant

ArrFnd = Array("Findterm1", "Findterm2", "Findterm3", "Findterm4")

ArrRep = Array("Replaceterm1", "Replaceterm2", "Replaceterm3", "Replaceterm4")

With ActiveDocument.StoryRanges(wdEndnotesStory).Find

  .ClearFormatting

  .Replacement.ClearFormatting

  .Forward = True

  .Wrap = wdFindContinue

  .Format = True

  For i = 1 To UBound(ArrRep)

    .Text = ArrFnd(i)

    .Replacement.Text = ArrRep(i)

    .Execute Replace:=wdReplaceAll

  Next

End With

End Sub

Sub EndnoteFndRep2()

Dim i As Long, ArrFndRep As Variant

ArrFndRep = Array("Findterm1", "Replaceterm1", "|", "Findterm2", "Replaceterm2", _

            "|", "Findterm3", "Replaceterm3", "|", "Findterm4", "Replaceterm4")

With ActiveDocument.StoryRanges(wdEndnotesStory).Find

  .ClearFormatting

  .Replacement.ClearFormatting

  .Forward = True

  .Wrap = wdFindContinue

  .Format = True

  For i = 1 To UBound(ArrFndRep) Step 3

    .Text = ArrFndRep(i)

    .Replacement.Text = ArrFndRep(i + 1)

    .Execute Replace:=wdReplaceAll

  Next

End With

End Sub

Sub EndnoteFndRep3()

Dim i As Long, ArrFnd(3) As Variant, ArrRep(3) As Variant

ArrFnd(0) = "Findterm1"

ArrRep(0) = "Replaceterm1"

ArrFnd(1) = "Findterm2"

ArrRep(1) = "Replaceterm2"

ArrFnd(2) = "Findterm3"

ArrRep(2) = "Replaceterm3"

ArrFnd(3) = "Findterm4"

ArrRep(3) = "Replaceterm4"

With ActiveDocument.StoryRanges(wdEndnotesStory).Find

  .ClearFormatting

  .Replacement.ClearFormatting

  .Forward = True

  .Wrap = wdFindContinue

  .Format = True

  For i = 1 To UBound(ArrRep)

    .Text = ArrFnd(i)

    .Replacement.Text = ArrRep(i)

    .Execute Replace:=wdReplaceAll

  Next

End With

End Sub

With the last one, note that the number included in the variable declaration must at least equal the number assigned to the last element.

Answer 4

Thanks! Works great. A few notes/questions:

• I got an error in FndRepRng on the array declarations. After I took out the "Const," it worked no problem.
• I guess because endnotes are automatically linked, it doesn't seem necessary to test each one to see if it's linked to the previous note. So I just used this portion of the code in Demo:

Dim Rng As Range

With ActiveDocument

For Each Rng In .StoryRanges

Call FndRepRng(Rng)

Next

End With

End Sub

Is there any reason I shouldn't do that if all I'm interested in is the endnotes story range? When I tested the above, changes were successfully made in each endnote.

• One thing I really like about the macro template I included in the OP is the numbered, vertical list of find and replace arrays:

wsFindArray(1) = "TK"

wsFindArray(2) = "TK"

wsReplaceArray(1) = "TK"

wsReplaceArray(2) = "TK"

This is really nice when I've got a few dozen changes to make, since I find it easier to keep track of which find item goes with which replace item. But with your macro, we've got a horizontal structure:

Const ArrFnd = Array("Findterm1", "Findterm2")

Const ArrRep = Array("Replaceterm1", "Replaceterm2")

This could get cumbersome. Is there any way to incorporate the vertical list approach in your macro?

Answer 5

You could use code like:

Sub Demo()

Application.ScreenUpdating = False

Dim Rng As Range, Sctn As Section, HdFt As HeaderFooter

With ActiveDocument

  For Each Rng In .StoryRanges

    Call FndRepRng(Rng)

  Next

  For Each Sctn In .Sections

    For Each HdFt In Sctn.Headers

      With HdFt

        If .LinkToPrevious = False Then

          Call FndRepRng(HdFt.Range)

        End If

      End With

    Next

    For Each HdFt In Sctn.Footers

      With HdFt

        If .LinkToPrevious = False Then

          Call FndRepRng(HdFt.Range)

        End If

      End With

    Next

  Next

End With

End Sub

Sub FndRepRng(Rng As Range)

Dim i As Long, ArrFnd, ArrRep

ArrFnd = Array("Findterm1", "Findterm2")

ArrRep = Array("Replaceterm1", "Replaceterm2")

With Rng.Find

  .ClearFormatting

  .Replacement.ClearFormatting

  .Forward = True

  .Wrap = wdFindContinue

  .Format = True

  For i = 0 To UBound(ArrRep)

    .Text = ArrFnd(i)

    .Replacement.Text = ArrRep(i)

    .Execute Replace:=wdReplaceAll

  Next

End With

End Sub

The above code will process the main story, textboxes, footnotes, endnotes, headers, footers, etc.