macro for performing more than one find and replace procedure at the same time

Anonymous
2010-08-07T18:21:24+00:00

ok, i've got to about 700!! find and replace procedures for a document of TWO MILLION words so this macro could save me about 4 hours of work.

i tried to rewrite this macro so that it would work but it didn't.  can anyone help me out

Sub Macro1()

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " mit der "
.Replacement.Text = " mitder"
.Text = " mit dem "
.Replacement.Text = " mitdem"
.Text = " mit den "
.Replacement.Text = " mitden"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Microsoft 365 and Office | Word | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments
Answer accepted by question author
Anonymous
2010-08-07T18:56:51+00:00

ok, i got it work, i just copied it over

Sub Macro1()

'

' Macro1 Macro

' Macro recorded 8/7/10 by Seely Foley

'

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = " mit der "

        .Replacement.Text = " mitder"

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = " mit den "

        .Replacement.Text = " mitden"

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

End Sub

Was this answer helpful?

30+ people found this answer helpful.
0 comments

53 additional answers

Sort by: Most helpful
Most helpful Newest Oldest
  1. Anonymous
    2016-08-19T06:50:29+00:00

    Thanks so much! It works well, although it does lock up Word with a "Not Responding" message before it finishes. I guess that's understandable given how many searches I made it execute.

    Was this answer helpful?

    0 comments
  2. Anonymous
    2016-08-18T21:47:13+00:00

    Graham's code replaces with a literal text string.  Try:

    Sub ReplaceFromTableList()

     Dim oDoc As Document, oDocFRPairs As Document

     Dim oTbl As Table

     Dim oRng As Range

     Dim strFind As String, strReplace As String

     Dim lngIndex As Long

      Set oDoc = ActiveDocument

      'Note change "ThisDocument.Path & "\Word List.docm" to reflect your actual FR pair list.

      Set oDocFRPairs = Documents.Open(FileName:=ThisDocument.Path & "\Word List.docm", Visible:=False)

      Set oTbl = oDocFRPairs.Tables(1)

      For lngIndex = 1 To oTbl.Rows.Count

       Set oRng = oTbl.Cell(lngIndex, 1).Range

       oRng.End = oRng.End - 1

       strFind = oRng.Text

       Set oRng = oTbl.Cell(lngIndex, 2).Range

       oRng.End = oRng.End - 1

       strReplace = oRng.Text

       Set oRng = oDoc.Range

       With oRng.Find

         .ClearFormatting

         .Replacement.ClearFormatting

         .MatchWildcards = True

         .Text = strFind

         .Replacement.Text = strReplace

         .Replacement.Highlight = True

         .Execute Replace:=wdReplaceAll

        End With

      Next lngIndex

    lbl_Exit:

      oDocFRPairs.Close wdDoNotSaveChanges

      Exit Sub

    End Sub

    Was this answer helpful?

    0 comments
  3. Anonymous
    2016-08-18T19:10:05+00:00

    I just modified the terms in the Do While block after .Execute, making MatchWildcards:=True rather than False. And for the attempted highlight, I added .Replacement.Highlight = True after the range find statement. I should have known it wouldn't be so easy...

    Was this answer helpful?

    0 comments
  4. Charles Kenyon 171K Reputation points Volunteer Moderator
    2016-08-18T13:35:15+00:00

    I would guess Graham will respond soon. He is much more knowledgeable in this area than am I.

    In the meantime,  ...

    When you use wildcards, you cannot also use the special codes.

    You may want to post the part of the code you tried modifying.

    Was this answer helpful?

    0 comments