# multiple find and replace macro



## kylefoley76

ok, i've got to do about 500 different find and replace operations so getting this macro written could save me maybe 4 hours of work. i'm just trying to figure out how you change the macro so that you do more than one find and replace operation.  i tried to change it myself but it didn't really work.  

this is also for word by the way, but i figure that there cannot be much difference between word and excel visual basic.  this macro works for one find and replace but not three. 



		Code:
__


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


----------



## Weaver

For this example, could you find "mit d" and replace with "mitd"?

Otherwise, you could create a table with the 'find' in column 1 and the 'replace' in column 2

It would be possible to loop through this table in vb and perform each find/replace in turn


----------



## kylefoley76

in the above example i had sheet with

mit der
mit den
mit dem

and it only changed one


----------



## Weaver

Something like



		Code:
__


Sub multiFindNReplace()
    Dim myList, myRange
    Set myList = Sheets("sheet3").Range("A8:B10") 'two column range where find/replace pairs are
    Set myRange = Sheets("sheet3").Range("D1:F100") 'range to be searched
    For Each cel In myList.Columns(1).Cells
        myRange.Replace what:=cel.Value, replacement:=cel.Offset(0, 1).Value
    Next cel
End Sub


----------



## kylefoley76

weaver,

thanks for trying to help me with my problem but i need it written for word not excel.  i know this is an excel forum, but all the word forums have hardly any visitors


----------



## Weaver

Shame on me for not reading your post fully!





kylefoley76 said:


> weaver,
> 
> thanks for trying to help me with my problem but i need it written for word not excel.  i know this is an excel forum, but all the word forums have hardly any visitors


I can only suggest you paste all your text into Excel run the code and then paste it back.  I can't imagine how you'd perform this in Word.


----------



## kylefoley76

this is a text of 2 million words and 6,000 pages.  i think it would overload excel.  but thanks for taking the time to try and help me


----------



## kylefoley76

ok, i got it to work, i just recopied it

Sub Macro1()
'

'
    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


----------



## Weaver

Just a thought.  If you've got a lot of swaps to make, something like this might work.
This way you wouldn't have to copy out the code multiple times.



		Code:
__


findArray = array(" mit der "," mit den "," mit dem ")
replArray = array(" mitder"," mitden"," mitdem")

for i =0 to ubound(findArray)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = findArray(i)
.Replacement.Text = replArray(i)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
next i

Let me know if it works


----------



## Peter_SSs

kylefoley76 said:


> ... i need it written for word not excel.  i know this is an excel forum, but all the word forums have hardly any visitors


Never-the-less a question about Word does not belong in the Excel Questions forum. Therefore I have moved it.


----------

