Replace array of words only in table

[SmallFry]

I found this macro which works in part, but falls short of only making the changes in tables.

Code: Select all

Sub MultiReplace()
    Dim RngFind     As Range
    Dim RngTxt      As Range
    Dim i           As Long
        
    Dim StrOld() As Variant: StrOld = Array("RDR", "MNGT", "FID")
    Dim StrNew() As Variant: StrNew = Array("RADAR", "MANAGEMENT", "FOUND ID")

    Selection.HomeKey Unit:=wdStory
    Set RngTxt = Selection.Range
    For i = 0 To UBound(StrOld)
        Set RngFind = RngTxt.Duplicate
        With RngFind.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = StrOld(i)
            .Replacement.Text = StrNew(i)
            .Format = False
            .MatchWholeWord = True
            .MatchAllWordForms = False
            .MatchWildcards = False
            .Execute Replace:=wdReplaceAll
        End With
    Next
    
    Set RngFind = Nothing: Set RngTxt = Nothing
    
End Sub

[HansV]

Does this do what you want?

Code: Select all

Sub MultiReplace()
    Dim i        As Long
    Dim StrOld() As Variant: StrOld = Array("RDR", "MNGT", "FID")
    Dim StrNew() As Variant: StrNew = Array("RADAR", "MANAGEMENT", "FOUND ID")
    Application.ScreenUpdating = False
    For i = 0 To UBound(StrOld)
        Selection.HomeKey Unit:=wdStory
        With Selection.Find
            .ClearFormatting
            .Text = StrOld(i)
            .Format = False
            .MatchWholeWord = True
            .MatchAllWordForms = False
            .MatchWildcards = False
            .Wrap = wdFindStop
            Do While .Execute
                If Selection.Information(wdWithInTable) Then
                    Selection.Text = StrNew(i)
                    Selection.Collapse Direction:=wdCollapseEnd
                End If
            Loop
        End With
    Next
    Application.ScreenUpdating = True
End Sub

[SmallFry]

Hi Hans,

Indeed it does. Works perfectly. Thank you.