We help IT Professionals succeed at work.

How do I improve a macro to search and replace various words in Microsoft Word?

speechrec
speechrec asked
on
I have a word-macro that automates some search and replace operations (error spelling).

I have found a way to put several of these operations in one macro. There is a hitch, though: after finishing one correction, it always prompts me if I want to start again from the top in Word 2010.

Questions:

1. Remove prompt

Would someone please adapt this macro so it replaces all instances "du - Du, dein - Deiner..." in the given file without asking if I really want to do that?
I'm no VBA specialist. The few macros I have are either recorded or from Google.

2. Adding more search terms

Is there a more elegant way of adding more search terms to the macro?
Right now, I copy and paste the existing code and add it below while replacing the search and replace terms.

Thanks.

Here is what I have:

Sub Du()
' Gross-/Kleinschreibung:
' du, dir, dich, dein, deine, deinen, deinem, deiner
'
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "du"
       .Replacement.Text = "Du"
       .Forward = True
       .Wrap = wdFindAsk
       .Format = False
       .MatchCase = False
       .MatchWholeWord = True
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "dir"
       .Replacement.Text = "Dir"
       .Forward = True
       .Wrap = wdFindAsk
       .Format = False
       .MatchCase = False
       .MatchWholeWord = True
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "dich"
       .Replacement.Text = "Dich"
       .Forward = True
       .Wrap = wdFindAsk
       .Format = False
       .MatchCase = False
       .MatchWholeWord = True
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "dich"
       .Replacement.Text = "Dich"
       .Forward = True
       .Wrap = wdFindAsk
       .Format = False
       .MatchCase = False
       .MatchWholeWord = True
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "dein"
       .Replacement.Text = "Dein"
       .Forward = True
       .Wrap = wdFindAsk
       .Format = False
       .MatchCase = True
       .MatchWholeWord = True
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "deine"
       .Replacement.Text = "Deine"
       .Forward = True
       .Wrap = wdFindAsk
       .Format = False
       .MatchCase = True
       .MatchWholeWord = True
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "deinen"
       .Replacement.Text = "Deinen"
       .Forward = True
       .Wrap = wdFindAsk
       .Format = False
       .MatchCase = True
       .MatchWholeWord = True
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "deinem"
       .Replacement.Text = "Deinem"
       .Forward = True
       .Wrap = wdFindAsk
       .Format = False
       .MatchCase = True
       .MatchWholeWord = True
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "deiner"
       .Replacement.Text = "Deiner"
       .Forward = True
       .Wrap = wdFindAsk
       .Format = False
       .MatchCase = False
       .MatchWholeWord = True
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Open in new window

Comment
Watch Question

Top Expert 2011
Commented:
Try the following ... hopefully self explanatory.
Sub Du()
' Gross-/Kleinschreibung:
Dim wrds As Variant
Dim wrd As Variant
   
    wrds = Array("du", "dir", "dich", "dein", "deine", "deinen", "deinem", "deiner")
    For Each wrd In wrds
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With ActiveDocument.Range.Find
            .Text = CStr(wrd)
            .Replacement.Text = UCase(Left(wrd, 1)) & LCase(Right(wrd, Len(wrd) - 1))
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute Replace:=wdReplaceAll
        End With
    Next
End Sub

Open in new window

Author

Commented:
Thank you, I absolutely love it!