Is it possible to loop a find and replace array?

[Paul_Hossler]

Using Wildcards

 
Option Explicit
Sub ArrFndRep()
    Dim ArrFR As Variant, i As Long
    
    ArrFR = Array( _
        " {2,}", " ", _
        vbTab & "{2,}", vbTab, _
        vbTab & "{2,}^0013", "^0013", _
        " {1,}^0013", "^0013", _
        "^0013{2,}", "^0013" _
        )
    
    If UBound(ArrFR) Mod 2 = 0 Then
      MsgBox "Something's Wrong Genious"    '   Like it :-)
      Exit Sub
    End If
    
    With ActiveDocument.Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .MatchWholeWord = True
      .MatchCase = False
      .MatchWildcards = True ' <<<<<<<<<<<<<<<<
      .Wrap = wdFindContinue
      For i = 0 To UBound(ArrFR) Step 2
        .Text = ArrFR(i)
        .Replacement.Text = ArrFR(i + 1)
        .Execute Replace:=wdReplaceAll
      Next
    End With
End Sub