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 No 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 No comments

53 additional answers

Sort by: Most helpful
  1. Anonymous
    2015-02-26T07:10:54+00:00

    Thanks for your help, Doug.

    I copied the code exactly as written (and added the End Sub line that was missing), but when I run it I get a run-time error (#4198) in this set of lines:

    Do While .Execute(findText:=rFindText, _

                     MatchWildcards:=True, _

                     Forward:=True, _

                     Wrap:=wdFindContinue, Replacewith:=rReplacement) = True

    I tried removing the underscores and making it one line, but that didn't work either.

    I'm stumped as my knowledge of VBA is limited.

    Was this answer helpful?

    0 comments No comments
  2. Doug Robbins - MVP - Office Apps and Services 323.6K Reputation points MVP Volunteer Moderator
    2015-02-26T02:05:17+00:00

    Your code is just replacing the found text with the text contained in the replacement range.

    Using the following should make the replacement properly

    Sub ReplaceFromTableList()

     Dim oChanges As Document, oDoc As Document

     Dim oTable As Table

     Dim oRng As Range

     Dim rFindText As Range, rReplacement As Range

     Dim i As Long

     Dim sFname As String

     'Change the path in the line below to reflect the name and path of the table document

     sFname = "C:\Users\rhonda\AppData\Roaming\Microsoft\Word\STARTUP\find_and_replace_routines_macro.docx"

     Set oDoc = ActiveDocument

     Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)

     Set oTable = oChanges.Tables(1)

     For i = 1 To oTable.Rows.Count

         Set oRng = oDoc.Range

         Set rFindText = oTable.Cell(i, 1).Range

         rFindText.End = rFindText.End - 1

         Set rReplacement = oTable.Cell(i, 2).Range

         rReplacement.End = rReplacement.End - 1

         With oRng.Find

                 .ClearFormatting

                 .Replacement.ClearFormatting

                 Do While .Execute(findText:=rFindText, _

                     MatchWildcards:=True, _

                     Forward:=True, _

                     Wrap:=wdFindContinue, Replacewith:=rReplacement) = True

                 Loop

         End With

     Next i

     oChanges.Close wdDoNotSaveChanges

    Was this answer helpful?

    0 comments No comments
  3. Anonymous
    2015-02-25T22:14:42+00:00

    Hi Doug

    Here is the code:

    Sub ReplaceFromTableList()

    Dim oChanges As Document, oDoc As Document

    Dim oTable As Table

    Dim oRng As Range

    Dim rFindText As Range, rReplacement As Range

    Dim i As Long

    Dim sFname As String

    'Change the path in the line below to reflect the name and path of the table document

    sFname = "C:\Users\rhonda\AppData\Roaming\Microsoft\Word\STARTUP\find_and_replace_routines_macro.docx"

    Set oDoc = ActiveDocument

    Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)

    Set oTable = oChanges.Tables(1)

    For i = 1 To oTable.Rows.Count

        Set oRng = oDoc.Range

        Set rFindText = oTable.Cell(i, 1).Range

        rFindText.End = rFindText.End - 1

        Set rReplacement = oTable.Cell(i, 2).Range

        rReplacement.End = rReplacement.End - 1

        With oRng.Find

                .ClearFormatting

                .Replacement.ClearFormatting

                Do While .Execute(findText:=rFindText, _

                    MatchWildcards:=True, _

                    Forward:=True, _

                    Wrap:=wdFindContinue) = True

                    oRng.Text = rReplacement

                Loop

        End With

    Next i

    oChanges.Close wdDoNotSaveChanges

    End Sub

    Was this answer helpful?

    0 comments No comments
  4. Doug Robbins - MVP - Office Apps and Services 323.6K Reputation points MVP Volunteer Moderator
    2015-02-25T09:35:39+00:00

    It will be easier to help you if you show us the code of the macro that you are using.

    Was this answer helpful?

    0 comments No comments