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

Final update: Once I made those same changes in the macros.dotm in the STARTUP folder, it worked with all documents with no errors.

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!

Thanks, Doug! About to try it now.

However, when I pasted the code into the VBA code window, I got red (error) lines for the Forward, Wrap, and Execute lines. When I removed the ':' in each of these lines and added a space before and after the '=', the red went away.

But when I tried to run it on a test document, I got yet another error message: "Compile error in hidden module: NewMacros. This error commonly occurs when code is incompatible with the version, platform, or architecture of this application. Click 'Help' for information on how to correct this error." The Help indicated it might be a 32-bit doc trying to work with a 64-bit Office, but even though I have a 64-bit machine, I installed 32-bit Office on it. 

I'll keep persevering and see if I can recreate my Macros.dotm document in my current version of Word (I think I created it in Word 2007).

I'll let you know how I go.

Try this:

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 = "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 wdStorey

     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