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: Oldest
Most helpful Newest Oldest
  1. 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
  2. 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
  3. Anonymous
    2016-08-20T05:21:09+00:00

    Add a line

    DoEvents

    immediately before

    Next lngIndex

    which should eliminate the Not Responding message (though it should in any case complete).

    Was this answer helpful?

    0 comments
  4. Anonymous
    2016-08-21T01:28:02+00:00

    Thanks, that's helpful.

    Was this answer helpful?

    0 comments