Find and Replace Array in MS Word, Runs but doesn't Work

[mrmmickle1]

I have been trying to get this simple find and replace macro to work but have been unsuccessful. I have no experience with VBA in word so I am unsure where I am going wrong. Any help would be much appreciated. Here is what I have. I tried to comment it to make it easier to understand what I am attempting to do:

Sub ReplaceWords()

 Dim vFindText    As Variant
 Dim vReplText    As Variant
 Dim i                 As Long
 

 vFindText = Array("uc14-*", "rf14-*", "sa14-*", "SKAT")  [COLOR=#008000]'Set Find Array[/COLOR]
 
 vReplText = Array("", "", "", "")  [COLOR=#008000]'Set Replacement Array[/COLOR]
  
  Selection.WholeStory [COLOR=#008000]'Select All Text in Document[/COLOR]
  With Selection.Find
 .Forward = True
 .Wrap = wdFindContinue
 .MatchWholeWord = True
 .MatchWildcards = False
 .MatchSoundsLike = False
 .MatchAllWordForms = False
 .Format = True
 .MatchCase = True
 
[COLOR=#008000] 'Replace each item from the first array with the corresponding item in the second array[/COLOR]
 For i = LBound(vFindText) To UBound(vFindText) 
 .Text = vFindText(i)
 .Replacement.Text = vReplText(i)
 .Execute Replace:=wdReplaceAll
 
 Next i
 End With
 
 End Sub

 

[Macropod]

Your code works for me. Just few code tweaks:

Sub ReplaceWords()
Application.ScreenUpdating = False
Dim vFindText    As Variant
Dim vReplText    As Variant
Dim i                 As Long
 
vFindText = Array("uc14-*", "rf14-*", "sa14-*", "SKAT")  'Set Find Array
vReplText = Array("", "", "", "")  'Set Replacement Array

With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = False
  .Forward = True
  .MatchCase = True
  .Wrap = wdFindContinue
  .MatchWholeWord = True
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  
  '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
Application.ScreenUpdating = True
End Sub

 

[mrmmickle1]

Paul,

Thank you so much for the modifications! Worked like a charm!!!