Word Macro to Automatically Find and Replace Multiple Terms in Multiple Files
top of page
Search
    • Aug 26, 2015

Word Macro to Automatically Find and Replace Multiple Terms in Multiple Files


If you've got a list of multiple terms and you need to find and replace them with other terms in one or more Word files, there's a great macro which provides a solution. Tonight I began a Litigation Support Tip of the Night YouTube channel. You may need to click on the individual page for this night's post to view the video. See also: https://www.youtube.com/watch?v=UezfKjoR5mk

2. Scroll down and select the second posting of the zip file named, "ReplaceMulti.zip"

3. Open the document in the zip file and enable editing.

4. Press ALT + F11 to go into Visual Basic. An edited version of the macro is posted below.

5. Edit the section at the top of the macro which lists the terms to find and replace:

Const Find1 = " first find string " Const Replace1 = " first replacement "

Const Find2 = " second find string " Const Replace2 = " second replacement "

6. Put Const Find1 in one column in Excel so you can pull it down using the AutoFill handle and generate Const Find2, Const Find3 and so forth. Put = " in another column, followed by the terms you want to find, and then " in a fourth column. Repeat in four columns to the right with the Const Replace command and the terms that are being added in.

7. Use the Fill . . . Series command to number the find script and the replace script so you can sort them in order.

8. Paste all of the columns into Word, and then remove the ^t tab marks in find & replace. Edit down the script so it looks like the language from the original.

9. Be sure to add in an extra return before each Find and Replace pair.

10. Now paste the language back into the macro in Visual Basic for the original ReplaceMulti file.

11. Now similarly edit the .Execute Find language from further down in the macro so that you have the same number of commands as terms listed for replacement. Be sure to add spaces before the .Execute commands.

12. When you're done the macro should be ready to run. Be sure to close the document(s) that you want the macro to operate on.

13. Just press the play button in Visual Basic to start the process. The macro will prompt you to select the files in which the specifed terms need to be replaced.

14. Voila! The find and replace commands should execute. The example in the video only contains five commands to be run a very short document, but I have used the macro to replace more than a 100 terms in a 60 page memo, and it works very fast under those circumstances as well.

Sub DoReplace()

Const Find1 = " first find string " Const Replace1 = " first replacement "

Const Find2 = " second find string " Const Replace2 = " second replacement "

Dim FilePick As FileDialog Dim FileSelected As FileDialogSelectedItems Dim WordFile As Variant ' FileName placeholder in selected files loop Dim FileJob As String ' Filename for processing

Dim WorkDoc As Object Dim WholeDoc As Range Dim FooterDoc As Range

On Error GoTo DoReplace_Error Set FilePick = Application.FileDialog(msoFileDialogFilePicker) With FilePick .Title = "Choose Report Template" .Filters.Clear .Filters.Add "Word Documents & Templates", "*.do*" .Filters.Add "Word 2003 Document", "*.doc" .Filters.Add "Word 2003 Template", "*.dot" .Filters.Add "Word 2007 Document", "*.docx" .Filters.Add "Word 2007 Template", "*.dotx" .Show End With Set FileSelected = FilePick.SelectedItems

If FileSelected.Count <> 0 Then For Each WordFile In FileSelected FileJob = WordFile Set WorkDoc = Application.Documents.Open(FileJob, , , , , , , , , , , False) Set WholeDoc = WorkDoc.Content Set FooterDoc = WorkDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range With FooterDoc .Find.Execute Find1, True, True, , , , True, , , Replace1, wdReplaceAll .Find.Execute Find2, True, True, , , , True, , , Replace2, wdReplaceAll End With With WholeDoc.Find .Execute Find1, True, True, , , , True, , , Replace1, wdReplaceAll .Execute Find2, True, True, , , , True, , , Replace2, wdReplaceAll End With

WorkDoc.Save WorkDoc.Close Next End If MsgBox "Completed" DoReplace_Exit: Set WholeDoc = Nothing Set FilePick = Nothing

Set WorkDoc = Nothing Set FooterDoc = Nothing

Exit Sub

DoReplace_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DoReplace of VBA Document ReplaceMulti" Resume DoReplace_Exit End Sub


bottom of page