macro for performing more than one find and replace procedure at the same time

If you have as many as 700 replacements, then you are going to have to be very careful in which order they are searched as the subsequent searches will also search the replaced terms and you will need to watch out for potential conflicts. While Doug has suggested an array - which may work - 700 items is a lot to accommodate. For this reason, I would urge you to create a two column Word table to hold your terms and replacements. The following macro will replace all the words in the first column with the corresponding words in the second column.

Sub ReplaceFromTableList()

Dim oChanges As Document, oDoc As Document

Dim oTable As Table

Dim oRng As Range

Dim rFindText As Range, rReplacement As Range

Dim i As Long

Dim sFname As String

'Change the path in the line below to reflect the name and path of the table document

sFname = "D:\My Documents\Test\Changes.doc"

Set oDoc = ActiveDocument

Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)

Set oTable = oChanges.Tables(1)

For i = 1 To oTable.Rows.Count

    Set oRng = oDoc.Range

    Set rFindText = oTable.Cell(i, 1).Range

    rFindText.End = rFindText.End - 1

    Set rReplacement = oTable.Cell(i, 2).Range

    rReplacement.End = rReplacement.End - 1

    With oRng.Find

            .ClearFormatting

            .Replacement.ClearFormatting

            Do While .Execute(findText:=rFindText, _

                MatchWholeWord:=True, _

                MatchWildcards:=False, _

                Forward:=True, _

                Wrap:=wdFindContinue) = True

                oRng.Text = rReplacement

            Loop

    End With

Next i

oChanges.Close wdDoNotSaveChanges

End Sub

This is really helpful to me - I've been trying to create a macro which introduced typos for literacy work.

I have increased the number of columns on the table to 6, giving five typos for each correct spelling.  Unfortunately every time a word is replaced a new line is created -can you help?

Sub ReplaceFromTableList()

Dim oChanges As Document, oDoc As Document

Dim oTable As Table

Dim oRng As Range

Dim rFindText As Range, rReplacement As Range

Dim i As Long

Dim sFname As String

Dim x As Integer

'Change the path in the line below to reflect the name and path of the table document

sFname = "C:\Users\cthom\Desktop\changes.docx"

Set oDoc = ActiveDocument

Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)

Set oTable = oChanges.Tables(1)

For i = 1 To oTable.Rows.Count

    Set oRng = oDoc.Range

    Set rFindText = oTable.Cell(i, 1).Range

    rFindText.End = rFindText.End - 1

    'Create a random x between 2 and 5

Randomize

x = Int(5 * Rnd()) + 1

     Set rReplacement = oTable.Cell(i, x).Range

    rReplacement.End = rReplacement.End - 1

    With oRng.Find

           ' .ClearFormatting

           ' .Replacement.ClearFormatting

            Do While .Execute(findText:=rFindText, _

                MatchWholeWord:=True, _

                MatchWildcards:=False, _

                Forward:=True, _

                Wrap:=wdFindContinue) = True

                Randomize

x = Int(5 * Rnd()) + 1

Set rReplacement = oTable.Cell(i, x).Range

                oRng.Text = rReplacement

            Loop

    End With

Next i

oChanges.Close wdDoNotSaveChanges

End Sub

I'm still having trouble getting that code to run from my global macros.dotm in my STARTUP folder. However, I stuck it directly into the doc and had a bit more success, though still with Debug errors.

VBA didn't like this line: Selection.HomeKey wdStorey

So I changed it to wdStory (i.e. no 'e') and it seems to have worked without error! I also had to put the colon back into this line and get rid of the spaces around the '=': .Execute Replace:=wdReplaceAll

So the final code that worked on my test doc is:

Sub ReplaceFromTableList()

' from Doug Robbins, Word MVP, Microsoft forums, Feb 2015, based on another macro written by Graham Mayor, Aug 2010

 Dim oChanges As Document, oDoc As Document

 Dim oTable As Table

 Dim oRng As Range

 Dim rFindText As Range, rReplacement As Range

 Dim i As Long

 Dim sFname As String

 'Change the path in the line below to reflect the name and path of the table document

 sFname = "C:\Users\rhonda\AppData\Roaming\Microsoft\Word\STARTUP\find_and_replace_routines_macro.docx"

 Set oDoc = ActiveDocument

 Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)

 Set oTable = oChanges.Tables(1)

 For i = 1 To oTable.Rows.Count

     Set oRng = oDoc.Range

     Set rFindText = oTable.Cell(i, 1).Range

     rFindText.End = rFindText.End - 1

     Set rReplacement = oTable.Cell(i, 2).Range

     rReplacement.End = rReplacement.End - 1

     Selection.HomeKey wdStory

     With oRng.Find

             .ClearFormatting

             .Replacement.ClearFormatting

             .MatchWildcards = True

             .Text = rFindText.Text

             .Replacement.Text = rReplacement.Text

             .Forward = True

             .Wrap = wdFindContinue

             .Execute Replace:=wdReplaceAll

       End With

 Next i

 oChanges.Close wdDoNotSaveChanges

End Sub

I'm now running it on a complex 400p test doc, with some 110 F&R routines in the file with the table in it. If it works, it will replace some 5000 instances where non-breaking spaces were required -- thus saving me a mountain of time running various F&R routines. (Finished! It took about 4 minutes!!!)

Thank you SO much!

I realise this is a very old thread, but I needed a multiple find and replace (F&R) macro that dealt with 100+ wildcard F&R routines. This macro appears to work very well, but perhaps too well in my case. In case it matters, I'm using Word 2010.

I created a doc with a single 2-column table with 'find' routines in the left column and 'replace' routines in the right. I used the wildcard syntax as I run all these as wildcard F&R routines. For example, I had a routine to search for a number followed by a space followed by a month name--in wildcard speak that's something like ([0-9])( )(May). I wanted to replace it with the same text except for the space, which I wanted as a non-breaking space; i.e. \1^s\3. 

I changed three lines in the macro -- the one that pointed to my Word doc containing the table, the 'MatchWholeWord' to False, and the 'MatchWildcards' to True. I changed nothing else.

I added this slightly revised macro to a macros.dotm doc I store in my Word>STARTUP folder. And then I opened a large doc and ran the macro on it. After several minutes, it was finished. However, everything that was searched for was replaced by the ACTUAL text in the 'replace' column, and Word didn't consider it as wildcard syntax.

The macro correctly searched for all instances in the first column, using the wildcard syntax. But the text it replaced it with ignored the wildcard setting and went in as \1^s\3. So instead of 9 May being replaced with 9<non-breaking space>May, it got replaced with \1^s\3.

I also tried putting parentheses around the elements in the replace syntax--i.e. ( \1)(^s)(\3)--but again, it just went in as that text, and not as I would've expected had I done a Ctrl+H F&R routine with wildcards checked.

Can anyone help? What line(s) do I need to add/change/delete in the macro for it to read the contents of the 'replace' column as wildcard syntax, and not as text?

Thanks!

--Rhonda