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

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

If you have as many as 700 replacements, then you are going to have to be very careful in which order they are searched as the subsequent searches will also search the replaced terms and you will need to watch out for potential conflicts. While Doug has suggested an array - which may work - 700 items is a lot to accommodate. For this reason, I would urge you to create a two column Word table to hold your terms and replacements. The following macro will replace all the words in the first column with the corresponding words in the second column.

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 = "D:\My Documents\Test\Changes.doc"

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, _

                MatchWholeWord:=True, _

                MatchWildcards:=False, _

                Forward:=True, _

                Wrap:=wdFindContinue) = True

                oRng.Text = rReplacement

            Loop

    End With

Next i

oChanges.Close wdDoNotSaveChanges

End Sub

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

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