[SOLVED] Word VBA macro to with multiple find/replace options for single-word selection only works if the selection contains the first F/R option

Word VBA macro to with multiple find/replace options for single-word selection only works if the selection contains the first F/R option

I have created a series of macros to select the next word, ignore the space and punctuation, and replace the word based on multiple find/replace options. I actually have 12 macros that are all based on this principal.

I have longer, more bloated versions of these macros that have worked great for years, but I'm now looking to streamline and trim them down and make them less bloated. The macros are grouped in four groups of three, with each group doing identical functions with different strings of text: first macro replacing a single-word selection, the second macro replacing all "finds" on a line, and the third macro replacing all "finds" in a (user-chosen) selection.

So far my single-word macro is working - sort of - but only if the selected word is the first word in the find string:

It was the first of October.

With my cursor somewhere on "the," the macro will replace "first" with "1st." But if the selected word was any other ordinal (second through ninth), it just ends up with the cursor at the beginning of the ordinal word - no error message.

Any suggestions as to what I'm doing wrong? Thanks in advance for any help!

Karen :)

Sub ReplaceNextOrdinal()

Dim StrFind As String, StrRepl As String
    
StrFind = "first,second,third,fourth,fifth,sixth,seventh,eighth,ninth"
StrRepl = "1st,2nd,3rd,4th,5th,6th,7th,8th,9th"

        Selection.MoveRight Unit:=wdWord, Count:=1
        
        With Selection.Find
            .Text = Split(StrFind, ",")
            .Replacement.Text = Split(StrRepl, ",")
            .IgnorePunct = True
            .IgnoreSpace = True
            .Execute Replace:=wdReplaceOne
        End With

End Sub

Solution

You're missing a loop over the array from Split()

Sub ReplaceNextOrdinal()
    'use const for fixed values
    Const StrFind = "first,second,third,fourth,fifth,sixth,seventh,eighth,ninth"
    Const StrRepl = "1st,2nd,3rd,4th,5th,6th,7th,8th,9th"
    
    Dim arrF, arrR, i As Long
    
    arrF = Split(StrFind, ",")
    arrR = Split(StrRepl, ",")
    
    Selection.MoveRight unit:=wdWord, Count:=1
    Selection.Expand unit:=wdWord 'select the word
    
    Debug.Print "Checking: " & Selection.Text
    For i = LBound(arrF) To UBound(arrF)
        With Selection.Find
            .Text = arrF(i)
            .MatchWholeWord = True
            .Replacement.Text = arrR(i)
            .IgnorePunct = True
            .IgnoreSpace = True
            If .Execute(Replace:=wdReplaceOne) Then Exit For  'found one!
        End With
    Next i
End Sub