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