How to replace Numbers in Parentheses with some calculations in MS Word

Question

I have a problem to replace some serial number such as [30] [31] [32]... to [31] [32] [33]... in MS word when I insert a new references in the middle of article. I have not found a solution way in GUI so I try to use VBA to do that replacement. I find a similar problem in stack overflow:

MS Word Macro to increment all numbers in word document

However, this way is a bit inconvenient because it have to generate some replacement array in other place. Can I make that replacement with regex and some function in MS Word VBA like code below?

Sub replaceWithregExp()

Dim regExp As Object
Dim regx, S$, Strnew$
Set regExp = CreateObject("vbscript.regexp")
With regExp
    .Pattern = "\[([0-9]{2})\]"
    .Global = True
End With
'How to do some calculations with $1?
Selection.Text = regExp.Replace(Selection.Text, "[$1]")
End Sub

But I don't know how to do some calculations with $1 in regExp? I have try use "[$1+1]" but it return [31+1] [32+1] [33+1]. Can anyone help? Thanks!

Answer 1

It is impossible to pass a callback function to the RegExp.Replace, so you have the only option: use RegExp.execute and process matches in a loop.

Here is an example code for your case (I took a shortcut since you only have the value to modify inside known delimiters, [ and ].)

Sub replaceWithregExp()

Dim regExp As Object
Dim regx, S$, Strnew$
Set regExp = CreateObject("vbscript.regexp")
With regExp
    .Pattern = "\[([0-9]{2})]"
    .Global = True
End With
'How to do some calculations with $1?
' Removing regExp.Replace(Selection.Text, "[$1]")
For Each m In regExp.Execute(Selection.Text)
    Selection.Text = Left(Selection.Text, m.FirstIndex+1) _
        & Replace(m.Value, m.Value, CStr(CInt(m.Submatches(0)) + 10)) _
        & Mid(Selection.Text, m.FirstIndex + Len(m.Value))
Next m

End Sub

Here,

• Selection.Text = Left(Selection.Text, m.FirstIndex+1) - Get what is before
• & Replace(m.Value, m.Value, CStr(CInt(m.Submatches(0)) + 10)) - Add 10 to the captured number
• & Mid(Selection.Text, m.FirstIndex + Len(m.Value)) - Append what is after the capture

Answer 2

That should do the trick :

Sub IncrementWithRegex()
    Dim Para As Paragraph
    Set Para = ThisDocument.Paragraphs.First
    Dim ParaNext As Paragraph
    Dim oRange As Range
    Set oRange = Para.Range
    Dim regEx As New RegExp
    Dim regMatch As Variant
    Dim ACrO As String

    With regEx
        .Global = True
        .MultiLine = False
        .IgnoreCase = False
        .Pattern = "[\[]([0-9]{2})[\]]"
    End With

    Do While Not Para Is Nothing
        Set ParaNext = Para.Next
        Set oRange = Para.Range
        'Debug.Print oRange.Text
        If regEx.test(oRange.Text) Then
            For Each regMatch In regEx.Execute(oRange.Text)
                oRange.Text = _
                    Left(oRange.Text, _
                         InStr(1, oRange.Text, CStr(regMatch))) & _
                    CDbl(regMatch) + 1 & _
                    Right(oRange.Text, _
                          Len(CStr(regMatch)) + InStr(1, oRange.Text, CStr(regMatch)))
            Next regMatch
        Else
        End If
        Set Para = ParaNext
    Loop
End Sub

To use this, remember to add the reference :

Description: Microsoft VBScript Regular Expressions 5.5
FullPath: C:\windows\SysWOW64\vbscript.dll\3
Major.Minor: 5.5
Name:     VBScript_RegExp_55
GUID: {3F4DACA7-160D-11D2-A8E9-00104B365C9F}

Answer 3

Here is a simple VBA macro you can use to achieve this :

Sub IncrementNumbers()

    Dim regExp As Object
    Dim i As Integer
    Dim fullMatch As String
    Dim subMatch As Integer
    Dim replacement As String
    Const TMP_PREFIX As String = "$$$"

    Set regExp = CreateObject("vbscript.regexp")
    With regExp
        .Pattern = "\[([0-9]{2})\]"
        .Global = True
        .MultiLine = True
    End With

    'Ensure selected text match our regex
    If regExp.test(Selection.Text) Then
        'Find all matches
        Set matches = regExp.Execute(Selection.Text)
        ' Start from last match
        For i = 0 To (matches.Count - 1)
            fullMatch = matches(i).Value
            subMatch = CInt(matches(i).SubMatches(0))
            'Increment by 1
            subMatch = subMatch + 1
            'Create replacement. Add a temporary prefix so we ensure [30] replaced with [31]
            'will not be replaced with [32] when [31] will be replaced
            replacement = "[" & TMP_PREFIX & subMatch & "]"
            'Replace full match with [subMatch]
            Selection.Text = Replace(Selection.Text, fullMatch, replacement)
        Next
    End If

    'Now replacements are complete, we have to remove replacement prefix
    Selection.Text = Replace(Selection.Text, TMP_PREFIX, "")

End Sub