Replace various words or phrases in a document from a table list, with a choice of replacements

It is fairly straightforward to use vba to search for a series of words or phrases from an array or from a document containing a table (or a list comprising each item in a separate paragraph) and then either processing the found words or replacing them with a corresponding word in the adjacent column of the same table. The following examples will do each of those things:

Replace a list of words from an array The following example uses a pair of arrays to hold corresponding lists of words, characters or phrases separated by commas. Items from the first list are replaced with the corresponding item from the second list vFindText = Array(Chr(147), Chr(148), Chr(145), Chr(146)) vReplText = Array(Chr(34), Chr(34), Chr(39), Chr(39)) In a practical use of the technique, the above example as shown in the macro below, is used to replace smart quotes with straight quotes (and vice versa), however the list and macro could be modified to be used to replace or process any sequence of words or phrases. Sub ReplaceQuotes() Dim vFindText As Variant Dim vReplText As Variant Dim sFormat As Boolean Dim sQuotes As String Dim i As Long 'Ask the user whether to format with smart or straight quotes sQuotes = MsgBox("Click 'Yes' to convert smart quotes to straight quotes." & vbCr & _ "Click 'No' to convert straight quotes to smart quotes.", _ vbYesNo, "Convert quotes") 'Record the current setting of the autoformat option to replace straight quotes with smart quotes sFormat = Options.AutoFormatAsYouTypeReplaceQuotes If sQuotes = vbYes Then 'The user has clicked 'Yes'      'Define the lists of smart quotes and their replacements      vFindText = Array(Chr(147), Chr(148), Chr(145), Chr(146))      vReplText = Array(Chr(34), Chr(34), Chr(39), Chr(39))      'Set the autoformat option to replace straight quotes with smart quotes to off      Options.AutoFormatAsYouTypeReplaceQuotes = False      'Start from the top of the document      Selection.HomeKey wdStory      With Selection.Find           .Forward = True           .Wrap = wdFindContinue           .MatchWholeWord = True           .MatchWildcards = False           .MatchSoundsLike = False           .MatchAllWordForms = False           .Format = True           .MatchCase = True           'replace each item from the first array with the corresponding item in the second array           For i = LBound(vFindText) To UBound(vFindText)                .Text = vFindText(i)                .Replacement.Text = vReplText(i)                .Execute Replace:=wdReplaceAll           Next i      End With Else 'User clicked 'No'      'Use autoformat to replace straight quotes with smart quotes      Options.AutoFormatReplaceQuotes = True      Selection.Range.AutoFormat End If 'Finally reset the autoformat setting to its start configuration Options.AutoFormatAsYouTypeReplaceQuotes = sFormat End Sub Replace a list of words from a table In the following example, the words and their replacements are stored in adjacent columns of a two column table stored in a document - here called "changes.doc". The name is unimportant and Word 2007/2010 users could use docx format. The table could also have more than two columns, but only the first two columns are used. Sub ReplaceFromTableList() Dim ChangeDoc, RefDoc As Document Dim cTable As Table Dim oFind, oReplace As Range Dim i As Long Dim sFname As String 'Define the document containing the table of words/phrases and their replacements sFname = "D:\My Documents\Test\changes.doc" 'Define the document to be processed Set RefDoc = ActiveDocument 'Open the document with the changes Set ChangeDoc = Documents.Open(sFname) 'Define the table to be used Set cTable = ChangeDoc.Tables(1) 'Activate the document to be processed RefDoc.Activate For i = 1 To cTable.Rows.Count      'Define the cell containing the word/phrase to be replaced      Set oFind = cTable.Cell(i, 1).Range      oFind.End = oFind.End - 1      'Define the cell containing the replacement word/phrase      Set oReplace = cTable.Cell(i, 2).Range      oReplace.End = oReplace.End - 1      With Selection           'Start at the top of the document           .HomeKey wdStory           'Replace the words/phrases           With .Find                .ClearFormatting                .Replacement.ClearFormatting                .Execute findText:=oFind, _                  ReplaceWith:=oReplace, _                  Replace:=wdReplaceAll, _                  MatchWholeWord:=True, _                  MatchWildcards:=False, _                  MatchCase:=True, _                  Forward:=True, _                  Wrap:=wdFindContinue           End With      End With Next i 'Close the document with the table ChangeDoc.Close wdDoNotSaveChanges End Sub