repeated find and replace

[Anonymous]

Hello
I am trying to write a macro that will search a document to replace
heshe, hisher and himher with he, she, his, her, him and her
depending on two radio buttons for male and female.

I'm using the code
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "heshe"
.Replacement.Text = "he"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute Replace:=wdReplaceAll

Do I have to repeat the whole code for each option or is there a
method of using an if statement for male and female and a loop for the
3 find.text options

 

[Greg Maxey]

Try something like:

Sub FRUsingAnArray()
Dim SearchArray As Variant
Dim ReplaceArray As Variant
Dim myRange As Range
Dim i As Long
Dim FindString As String
Dim RplString As String
Dim bMale As Boolean

bMale = True
If MsgBox("Routine is set form Male. Do you want to" _
& " change to Female?", vbYesNo) = vbYes Then
bMale = False
End If

SearchArray = Array("heshe", "himher", "hishers")
If bMale Then
ReplaceArray = Array("he", "him", "his")
Else
ReplaceArray = Array("she", "her", "hers")
End If
ResetFRParameters
Set myRange = ActiveDocument.Range
For i = 0 To UBound(SearchArray)
FindString = SearchArray(i)
RplString = ReplaceArray(i)
With myRange.Find
.Text = FindString
.Replacement.Text = RplString
.MatchWholeWord = True
.Execute Replace:=wdReplaceAll
End With
Next
End Sub
Sub ResetFRParameters()

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With

End Sub

 

[Anonymous]

Oops sorry for the reposting

Thanks for your help

Pete