Find and Prompt the user to Replace

Lawmuse · #1 11-02-2012, 04:04 PM

I'm new to vba, but have cobbled together some ideas from the forum for code to search a document for specific words and prompt the user to replace with a different word in case the first word was mistaken. For example, I write about statutes very often but sometimes type the word statue by mistake. Spell check obviously won't catch this, so I have a list of words and replacements that I often, but not always mistype.

I want to go through the document and find the uncommon word, like statue, then while I can see where the found text is on screen, I want to ask the user if he wants to replace this instance with statute instead. If so, replace it and continue the search. If not, continue searching for others until the end of the document.

Code:

Sub PromptReplace()
Dim Rng As Range, i As Long
Dim strFnd As String, strRpl As String
Dim fnd As String, rpl As String, choice As Integer
'find string
strFnd = "tot;tow;trail;contact;delivery;fist;form;latter;diffused;singed;sing;asset;tortuous;emotion;owning;statue;conversion"
'replace string in same order as strFnd
strRpl = "to;two;trial;contract;deliver;first;from;later;defused;signed;sign;assert;tortious;motion;owing;statute;conversation"
Selection.HomeKey Unit:=wdStory
For Each Rng In ActiveDocument.StoryRanges
    Set Rng = ActiveDocument.Range
    For i = 0 To UBound(Split(strFnd, ";"))
        fnd = Split(strFnd, ";")(i)
        rpl = Split(strRpl, ";")(i)
        With Rng.Find
            .ClearFormatting
            .Text = fnd
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindStop
            .Execute
        End With
        While Rng.Find.Found
            choice = MsgBox("Replace " + fnd + " with " + rpl + "?", _
                vbYesNoCancel + vbDefaultButton1, "Replace")
            If choice = vbYes Then
                Rng.Text = rpl  
                Rng.Collapse wdCollapseEnd 
            ElseIf choice = vbCancel Then
                GoTo endit
            Else
                Rng.Collapse wdCollapseEnd
            End If
            Rng.Find.Execute
        Wend
    Next i
Next Rng
endit:
Set Rng = Nothing
End Sub

This does most of what I want except I can't see the found text when the MsgBox pops up, so I can't tell the context in which I used the word. I'm also not sure that it is continue to search if I select No in response to the prompt. It also didn't find text in footnotes even though I was trying to loop through all storyRanges in the active document.

I would appreciate any comments about this code or possible suggestions for different ways to do this. Thanks.

macropod · #2 11-02-2012, 07:35 PM

Try:

Code:

Sub PromptReplace()
Dim Rng As Range, i As Long
Dim strFnd As String, strRpl As String
Dim fnd As String, rpl As String, choice As Integer
'find string
strFnd = "tot;tow;trail;contact;delivery;fist;form;latter;diffused;singed;sing;asset;tortuous;emotion;owning;statue;conversion"
'replace string in same order as strFnd
strRpl = "to;two;trial;contract;deliver;first;from;later;defused;signed;sign;assert;tortious;motion;owing;statute;conversation"
For i = 0 To UBound(Split(strFnd, ";"))
  fnd = Split(strFnd, ";")(i)
  rpl = Split(strRpl, ";")(i)
  For Each Rng In ActiveDocument.StoryRanges
    With Rng
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = fnd
        .Forward = True
        .Wrap = wdFindStop
        .Execute
      End With
      While .Find.Found
        .Duplicate.Select
        choice = MsgBox("Replace " & Chr(34) & fnd & Chr(34) & " with " & Chr(34) & rpl & Chr(34) & "?", _
                vbYesNoCancel + vbDefaultButton1, "Replace")
        If choice = vbYes Then
          .Text = rpl
        ElseIf choice = vbCancel Then
          GoTo endit
        End If
        .Collapse wdCollapseEnd
        .Find.Execute
      Wend
    End With
  Next Rng
Next i
endit:
Set Rng = Nothing
End Sub

Do be aware that the message box is liable to obscure the found text.

Lawmuse · #3 11-04-2012, 08:27 AM

Thank you. That seems to work perfectly. You revisions are very subtle, but it appears that the main difference is

Code:

.Duplicate.Select

Which I never would have discovered. So this creates a duplicate of the current range object, the current find, and selects it which highlights it on the screen behind the msgbox. Is there anything else I'm missing about this and how did you come up with it.

The other changes look like simple clean up stuff, though is moving the for each range... inside the for loop necessary... Never mind, I see now that it is. We need to set the ranges for each of the search pairs.

macropod · #4 11-04-2012, 01:45 PM

Quote:

how did you come up with it

I learnt about it by looking at how others had addressed similar problems.

Lawmuse · #5 11-05-2012, 09:36 AM

Another quick question. When the macro ends, the last found word remains highlighted, selected. Is there a way to turn that off? I don't want to accidentally delete that word by hitting a key after the macro finishes.

macropod · #6 11-05-2012, 01:30 PM

After:
endit:
insert:
Selection.Collapse

gmaxey · #7 11-06-2012, 05:51 AM

Gents,

Just tinkering here. Maybe I am missings something, but I don't see a need for .Duplicate in this case.

HTML Code:

Sub PromptReplace()
Dim oRngStart As Word.Range
Dim oRng As Range, lngIndex As Long
Dim arrFnd() As String, arrRpl() As String
Set oRngStart = Selection.Range
'find terms
arrFnd = Split("tot;tow;trail;contact;delivery;fist;form;latter;diffused;" _
& "singed;sing;asset;tortuous;emotion;owning;statue;conversion", ";")
'replace terms
arrRpl = Split("to;twos;trial;contract;deliver;first;from;later;defused;" _
& "signed;sign;assert;tortious;motion;owing;statute;conversation", ";")
 
For lngIndex = 0 To UBound(arrFnd)
For Each oRng In ActiveDocument.StoryRanges
With oRng.Find
.ClearFormatting
.Text = arrFnd(lngIndex)
.Forward = True
.Wrap = wdFindStop
While .Execute
Application.ScreenRefresh
oRng.Select
Select Case MsgBox("Replace " & Chr(34) & arrFnd(lngIndex) & Chr(34) & " with " & Chr(34) & arrRpl(lngIndex) & Chr(34) & "?", _
vbYesNoCancel + vbDefaultButton1, "Replace")
Case vbYes
oRng.Text = arrRpl(lngIndex)
Case vbCancel
GoTo lbl_Exit
End Select
oRng.Collapse wdCollapseEnd
Wend
End With
Next oRng
Next lngIndex
lbl_Exit:
oRngStart.Select
Set oRng = Nothing: Set oRngStart = Nothing
End Sub

macropod · #8 11-06-2012, 01:11 PM

Quote:

Originally Posted by gmaxey

Just tinkering here. Maybe I am missings something, but I don't see a need for .Duplicate in this case.

Perhaps not. When faced with these sorts of questions I tend to just grab & modify some boilerplate code I already have, without thinking too much about whether some aspects are really necessary. With F/R operations and others, .Duplicate can make a realy improvement processing in speed and can have other benefits. Any speed advantage is thoroughly negated one there's an interactive setup for every match, though.

gmaxey · #9 11-06-2012, 02:16 PM

Paul,

Thanks. .Duplicate is one of those things that I don't fully understand, but when I get tangled up in a VBA .Find process, I can sometimes work my way though it when I used .Duplicate.

If you have a good standard example(s) of how it impoves processing speed (and other benefits), I'd be happy to add them to the general tips section of:
http://gregmaxey.com/word_tip_pages/..._property.html

RaymondB7777 · #10 02-27-2023, 06:36 AM

Quote:

Originally Posted by gmaxey

Gents,

Just tinkering here. Maybe I am missings something, but I don't see a need for .Duplicate in this case.

HTML Code:

Sub PromptReplace()
Dim oRngStart As Word.Range
Dim oRng As Range, lngIndex As Long
Dim arrFnd() As String, arrRpl() As String
Set oRngStart = Selection.Range
'find terms
arrFnd = Split("tot;tow;trail;contact;delivery;fist;form;latter;diffused;" _
& "singed;sing;asset;tortuous;emotion;owning;statue;conversion", ";")
'replace terms
arrRpl = Split("to;twos;trial;contract;deliver;first;from;later;defused;" _
& "signed;sign;assert;tortious;motion;owing;statute;conversation", ";")
 
For lngIndex = 0 To UBound(arrFnd)
For Each oRng In ActiveDocument.StoryRanges
With oRng.Find
.ClearFormatting
.Text = arrFnd(lngIndex)
.Forward = True
.Wrap = wdFindStop
While .Execute
Application.ScreenRefresh
oRng.Select
Select Case MsgBox("Replace " & Chr(34) & arrFnd(lngIndex) & Chr(34) & " with " & Chr(34) & arrRpl(lngIndex) & Chr(34) & "?", _
vbYesNoCancel + vbDefaultButton1, "Replace")
Case vbYes
oRng.Text = arrRpl(lngIndex)
Case vbCancel
GoTo lbl_Exit
End Select
oRng.Collapse wdCollapseEnd
Wend
End With
Next oRng
Next lngIndex
lbl_Exit:
oRngStart.Select
Set oRng = Nothing: Set oRngStart = Nothing
End Sub

Hi Graham, I have modified your VBA to cater for my own specific requirements and it works well.

However, how would I go about restricting this to selected test only?

I have a number of tables with 2 columns.

Column 1 contains the original text (which does not necessarily contain the relevant Capitalized words)

Column 2 contains the text I have modified and added to and may or may not contain the the relevant Capitalized words. This is the column that I want to search/replace.

i.e. Column must 1 must not be searched/replaced.

Thanks in advance

Raymond

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Find, Replace	Ajay Shahane	Word VBA	4	05-16-2012 04:07 AM
Bad view when using Find and Find & Replace - Word places found string on top line	paulkaye	Word	4	12-06-2011 11:05 PM
Is there a way to use "find/replace" to find italics words?	slayda	Word	3	09-14-2011 02:16 PM
Help with find and replace or query and replace	shabbaranks	Excel	4	03-19-2011 08:38 AM
User Name Prompt Appears When Opening Documents	galleherjazz	Office	0	07-30-2009 08:15 PM