Using Arrays In Macro To Find And Replace ?? Help.

[Designingsally]

Hi there,
I got the code below. The code works perfectly fine.
But this code does not check the words sequentially. Instead it searches one
at a one ie. as you can see the array(1,2) is pen. So macros searches pen in
the whole doc one by one and replaces it. Notice in the array (2,1) is
lovely. If the macros encoutners the word lovely. It does nt change. Instead
it finshes checking all "pens" and then checks " lovely".

Though the working is fine, but it does not sound intelligent. I m unable to
link both of them together so that macros check words as they encounter.

Eg:
The pen is lovely. I like pens. There are different types of pens. All pens
are not lovely.

Trying running the macro with this. You will understand it better. I want
the code to use ARRAY, as it saves time for me to add more words.

I will be glad if anyone can come up with appropriate solution.

I have placed the code below. Thanks for the reply in advance. Thanks for
helping a beginner.

Sally

Sub PromptToReplace()

Dim orng As Range
Dim sRep As VbMsgBoxResult
Dim textArray As Variant
Dim i As Long

ReDim textArray(1 To 2, 1 To 2) As String
textArray(1, 1) = "pen"
textArray(1, 2) = "pencils"
textArray(2, 1) = "lovely"
textArray(2, 2) = "bad"
With Selection
For i = 1 To UBound(textArray, 1)
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
While .Execute(findText:=textArray(i, 1))
Set orng = Selection.Range
sRep = MsgBox("The incorrect word '" & _
textArray(i, 1) & _
"' was found in the following sentence:" _
& vbCrLf & orng.Sentences(1) & vbCrLf _
& vbCrLf & "Replace this word with '" & _
textArray(i, 2) & "'?", vbYesNoCancel)
Selection.Collapse Direction:=wdCollapseEnd
Selection.MoveStart Unit:=wdCharacter, Count:=1
If sRep = vbCancel Then
Exit Sub
ElseIf sRep = vbYes Then
orng.Text = textArray(i, 2)
End If
Wend
End With
Next
End With
End Sub

 

[Graham Mayor]

That's how the array works - each word is processd individually. Macros are
not intelligent.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Greg Maxey]

"Macros are not intelligent."

No, but people that can't sleep can sometimes bend them to their will ;-)

The following looks at each word in the document and will therefore be
slower (even significantly slower) than find and replace:


Option Explicit
Dim bClipSpace As Boolean
Dim bTerminate As Boolean

Sub PromptToReplace()
Dim aWord As Range
Dim myStr As String
Dim textArray() As String
Dim i As Long
ReDim textArray(1 To 5, 1 To 2) As String
textArray(1, 1) = "pen"
textArray(1, 2) = "pencil"
textArray(2, 1) = "pens"
textArray(2, 2) = "pencils"
textArray(3, 1) = "Pen"
textArray(3, 2) = "Pencil"
textArray(4, 1) = "Pens"
textArray(4, 2) = "Pencils"
textArray(5, 1) = "lovely"
textArray(5, 2) = "bad"
bTerminate = False
For Each aWord In ActiveDocument.Range.Words
myStr = aWord
bClipSpace = False
If InStrRev(myStr, " ") = Len(myStr) Then
myStr = Left(myStr, (Len(myStr) - 1))
bClipSpace = True
End If
For i = 1 To UBound(textArray, 1)
If myStr = textArray(i, 1) Then
ProcessWord aWord, textArray(i, 2)
End If
Next i
If bTerminate Then Exit Sub
Next
End Sub

Sub ProcessWord(ByRef oWord As Range, pStr As String)
oWord.Select
Select Case MsgBox("The incorrect word was found in the following sentence:"
_
& vbCr + vbCr & oWord.Sentences(1) & vbCr _
& vbCr & "Replace this word with " & pStr & "?", vbYesNoCancel)
Case vbYes
If bClipSpace Then
oWord.Text = pStr & " "
Else
oWord.Text = pStr
End If
Case vbCancel
bTerminate = True
End Select
End Sub