After first replacement, other search results are incorrectly selected

East · #1 08-05-2023, 12:27 AM

Hello

With the help of some AI bots, the Word macro below was generated to use regex in Find and Replace with a YesNoCancel prompt (macro runs from cursor position). The problem with this macro is that when the Find string and Replace string are not of the same length, the first replacing is done correctly, but then the other search results are incorrectly selected, and no replacing is showing. AI bots are suggesting updating cursor position, but all their solutions don't work!

Any help is much appreciated.

PS: The pattern and replacementtext in the macro below are just examples. I need the macro for cases that are not supported by wildcards.

Here's the macro:

Code:

Sub PromptRegExReplace()
    Dim regEx As Object
    Dim match As Object
    Dim matches As Object
    Dim rng As Range
    Dim response As Integer
    Dim replacementText As String

    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "([0-9])"
    regEx.Global = True

    ' Get the current cursor position
    Dim cursorPosition As Long
    cursorPosition = Selection.Start

    ' Set the range to start from the cursor position until the end of the document
    Set matches = regEx.Execute(ActiveDocument.Range(cursorPosition, ActiveDocument.Range.End).text)
    replacementText = "$1abc"

    For Each match In matches
        Set rng = ActiveDocument.Range(match.FirstIndex + cursorPosition, match.FirstIndex + match.Length + cursorPosition)
        rng.Select
        response = MsgBox("Replace this instance?", vbYesNoCancel)
        If response = vbYes Then
            Application.ScreenUpdating = False
            rng.text = regEx.replace(rng.text, replacementText)
            Application.ScreenUpdating = True

        ElseIf response = vbCancel Then
            Exit Sub
        End If
    Next match

End Sub

gmayor · #2 08-05-2023, 01:45 AM

Perhaps AI is not as good as you thought? If the idea is to optionally replace numbers with a string then the following will do that from the cursor position:

Code:

Sub Macro1()
Dim oRng As Range
Dim sAsk As String
Const sFindText As String = "[0-9]{1,}"
Const sReplaceText As String = "$1abc"
    Set oRng = Selection.Range
    oRng.End = ActiveDocument.Range.End
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        Do While .Execute(findText:=sFindText, _
                        MatchWildcards:=True, _
                        Forward:=True, _
                        Wrap:=wdFindStop) = True
            oRng.Select
            sAsk = MsgBox("Replace - " & vbCr & oRng.Text & vbCr + vbCr & _
                        "with - " & vbCr & sReplaceText, vbYesNo, _
                        "Replace Number")

            If sAsk = vbCancel Then GoTo lbl_Exit
                
            If sAsk = vbYes Then
                oRng.Text = sReplaceText
            End If
                oRng.Collapse wdCollapseEnd
        Loop
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

East · #3 08-05-2023, 04:25 AM

Hi gmayor

Thank you for replying. AI still needs a lot to deserve even the "I" in it.

As I mentioned in my post, ([0-9]) and $1abc are only examples. What I actually need cannot be easily covered by wildcards.

To simplify things, let's say that I want, with regex, to replace b([13579]*)c([13579]*)cd with b$1c$2c46d in instances that I choose.

I can use the macro here, but this requires creating hundreds of strings! That's why I need to use regex.

East · #4 08-07-2023, 01:55 AM

I think something like that should work.

Code:

Sub PromptRegExReplace()
Dim regEx As Object
Dim match As Object
Dim matches As Object
Dim rng As Range
Dim response As Integer
Dim replacementText As String

Set regEx = CreateObject("VBScript.RegExp")
regEx.pattern = "([0-9])"
regEx.Global = True

' Get the current cursor position
Dim cursorPosition As Long
cursorPosition = Selection.Start

' Set the range to start from the cursor position until the end of the document
Set matches = regEx.Execute(ActiveDocument.Range(cursorPosition, ActiveDocument.Range.End).text)
replacementText = "$1abc"

Do While matches.Count > 0
    Set match = matches(0)
    Set rng = ActiveDocument.Range(match.FirstIndex + cursorPosition, match.FirstIndex + match.Length + cursorPosition)
    rng.Select
    response = MsgBox("Replace this instance?", vbYesNoCancel)

    ' Check the value that is returned by the MsgBox function
    If response = vbYes Then
        Application.ScreenUpdating = False
        rng.text = regEx.replace(rng.text, replacementText)
        Application.ScreenUpdating = True

        ' Update the cursor position after replacing the text
        cursorPosition = rng.End

    ' No button moves without replacing
    ElseIf response = vbNo Then
        cursorPosition = rng.End

    ' Cancel button stops the macro
    ElseIf response = vbCancel Then
        Exit Sub
    End If

    ' Update the matches collection after replacing the text
    Set matches = regEx.Execute(ActiveDocument.Range(cursorPosition, ActiveDocument.Range.End).text)

Loop
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to keep a list of search results	Jedothek	Word	2	08-19-2020 07:22 AM
2013 search results take a long time - they fill in as results in reverse date order	themookman	Outlook	0	10-11-2013 12:01 PM
Outlook search too many results	alexb123	Outlook	1	10-10-2013 09:53 AM
Search results disappearing	Emerogork	Office	3	07-17-2011 03:52 PM
Instant Search's "Display search results as I type when possible" with Exchange	lwc	Outlook	0	06-01-2011 01:56 AM