Sub ReplaceFromTableWithFormatting()


' Slightly Tweaked from Graham Mayor's TableReplace Function
' And  Doug Robbins 
' Bulk Find & Replace From Table
'

 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
 
 '==================DOCUMENT LOCATION
 
 
   sFname = "C:\Users\Desktop\TableReplace.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
       
       
       ' Find only the exact formatted version as displayed in Column 1
       
       
            .Format = True       ' This may not be correct?
            .ClearFormatting
            .Replacement.ClearFormatting
            Do While .Execute(FindText:=rFindText, _
                              MatchWholeWord:=True, _
                              MatchWildcards:=False, _
                              Forward:=True, _
                              Wrap:=wdFindStop) = True
                oRng.Select
                oRng.FormattedText = rReplacement.FormattedText
                oRng.Collapse wdCollapseEnd
            Loop
        End With

           
       
 Next i
 oChanges.Close wdDoNotSaveChanges
 

End Sub