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. Doug Robbins - MVP - Office Apps and Services 323.6K Reputation points MVP Volunteer Moderator
    2017-02-22T10:20:46+00:00

    Replace

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

                    oRng.Text = rReplacement

    with

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

                    rReplacement.End = rReplacement.End - 1

                    oRng.Text = rReplacement

    Was this answer helpful?

    1 person found this answer helpful.
    0 comments
  2. Anonymous
    2011-12-05T01:12:04+00:00

    I agree with Graham that a tabular list is easier to manage.  I have a (commercial) macro that is similar to his, which I use to impose client preferences before I edit a document. I usually sort the list, but, as Graham suggests, I reorder  some items to avoid changes on already changed items.   I recommend that you first run it on a copy of the document until you are comfortable with the changes the macro makes and that you always run it with tracked changes turned on.

    Pam

    Was this answer helpful?

    0 comments
  3. Charles Kenyon 171K Reputation points Volunteer Moderator
    2011-12-04T20:11:23+00:00

    Thank you for posting this. It was just what I needed.

    Was this answer helpful?

    0 comments
  4. Doug Robbins - MVP - Office Apps and Services 323.6K Reputation points MVP Volunteer Moderator
    2010-08-07T21:38:57+00:00

    Use the following replacing the parts in [ ] by each of the items to be found and the items to be used for there replacements with each one separated by a comma

    Dim Findstr As Variant

    Dim Replacementstr As Variant

    Dim i As Long

    Findstr = Split("mit der, mit dem,[each of your other 700]", ",")

    Replacementstr = Split("mitder,mitdem,[each of the other 700]", ",")

    For i = 0 To UBound(Findstr)

        Selection.HomeKey wdStory

        Selection.Find.ClearFormatting

        With Selection.Find

            Do While .Execute(FindText:=Findstr(i), Forward:=True, _

                MatchWildcards:=False, Replacewith:=Replacementstr(i), _

                Wrap:=wdFindContinue, MatchCase:=False) = True

            Loop

        End With

    Next i

    Was this answer helpful?

    0 comments