The code i am working with doesn't go higher than 9, iif there is a double digit like 10 it assumes it is 1

Question

I am working with code that was created by someone else a long time ago, this code is meant to organize say a page with a table or specific that shows up multiple times in a page(like say a whole page with the same table over and over and over but its not just tables either) but the company software cant capture properly due to poor formatting in the PDF or limitations of the software. BWFinds is a class module and contains the things such as FindAndReplaceAll, FindAndReplaceEmphasis, etc EX:

Table 1

| Column A | Column B |
| --------   -------- |
| Cell 1   |              Cell 2   |

| Cell 3   | 
             Cell 4   |
 
Table 1
Column A 
Cell 1
Column A 
Cell 3
Column B 
Cell 2
Column B 
Cell 4 

bad example but basically in XML for this we capture Column A like example List_tableColumnA_MIPS1_LIST, The code would find this in the XML like <LIST><MIPS1>tableColumnA</MIPS1></LIST> and if it finds higher numbers MIPS2, MIPS3, etc then its would stack them in order as long as they are within the same section

My issue is that as the title Says, once it get past MIPS9 it only reads the first number so MIPS10 is treated like MIPS1. Here is the code i am working with:

Private Sub HandleMIPSRanges()
    
    On Error GoTo ErrorHandler
    EnterMethod "HandleMIPSRanges"
    
    Dim MIPStags As Collection: Dim lastOrder As Integer: Dim insertion As Range
    Dim sections As Collection: Dim thisSection As Range
    Set sections = BWFinds.FindAndReturnRanges("\<SECTIONSTART\>*\<\/SECTIONEND\>")
    
    For Each thisSection In sections
        If BWFinds.IsPatternFound("\<MIPS1\>", thisSection) Then
            lastOrder = 0
            Set insertion = Nothing
            Do While BWFinds.IsPatternFound("\<MIPS1\>", thisSection)
                Set MIPStags = BWFinds.FindAndReturnRanges("\<(MIPS[0-9]{1,})\>*\</\1\>", thisSection)
                OrderMIPSRanges MIPStags, lastOrder, insertion
            Loop
        End If
    Next
    BWFinds.FindAndReplaceAll "\<SECTIONSTART\>^13", ""
    BWFinds.FindAndReplaceAll "\<\/SECTIONEND\>^13", ""

ErrorHandler:
    If Err.Number <> 0 Then HandleError
    ExitMethod
    
End Sub

Private Sub OrderMIPSRanges(ByRef MIPStags As Collection, ByRef last As Integer, ByRef insertionRange As Range)
    
        Dim tagRange As Range
        Dim order As Integer
        Dim mipsNum As Integer: mipsNum = 6
        Dim continue As Boolean
        
        
        For Each tagRange In MIPStags
            order = tagRange.Characters(mipsNum)
            If last < order Then
               Select Case order
                Case 1
                    tagRange.Expand unit:=wdParagraph
                    RemoveMIPStag tagRange, order
                    Set insertionRange = tagRange
                    last = order
                Case 2 To 99
                    tagRange.Expand unit:=wdParagraph
                    RemoveMIPStag tagRange, order
                    insertionRange.InsertAfter vbNewLine & tagRange.Text
                    tagRange.Delete
                    last = order
                End Select
            ElseIf order = last Then
                continue = False
                continue = CheckNextMIPS(MIPStags, order + 1)
                If Not continue And CheckNextMIPS(MIPStags, 1) Then
                    last = 0
                    Exit For
                End If
                If continue And Not order = 99 Then last = order
            ElseIf Not continue And Not CheckNextMIPS(MIPStags, 1) Then
                last = 0
            End If
        Next
        
        last = 0
End Sub

Private Function CheckNextMIPS(ByVal MIPStags As Collection, ByVal order As Integer) As Boolean

    On Error GoTo ErrorHandler
    EnterMethod "CheckNextMIPS"
    
    Dim colRange As Range
    
    For Each colRange In MIPStags
        If BWFinds.IsPatternFound("\<MIPS" & order & "\>", colRange) Then CheckNextMIPS = True: Exit For
    Next
    
ErrorHandler:
    If Err.Number <> 0 Then HandleError
    ExitMethod
    
End Function

Private Sub RemoveMIPStag(ByVal tagRange As Range, ByVal order As Integer)

    On Error GoTo ErrorHandler
    EnterMethod "RemoveMIPStag"
    
    BWFinds.FindAndReplaceAll "(*)\<MIPS" & order & "\>(*)\<\/MIPS" & order & "\>(*)", "\1\2\3", tagRange
    
ErrorHandler:
    If Err.Number <> 0 Then HandleError
    ExitMethod

End Sub

I tried changing the Range, It worked in expanding past 9 but brought the issue i am currently having. O also tried increasing the number in Case 2 to 9 and Not Order = 9 as well but nothing. Changing mipsNum number to anything other than 6 breaks it

Answer 1

Your code has order = tagRange.Characters(mipsNum) (where mipsNum = 6) so it's only reading a single character.

Maybe you also need to read the next characters as long as they're also digits?

Private Sub OrderMIPSRanges(ByRef MIPStags As Collection, _
                            ByRef last As Integer, _
                            ByRef insertionRange As Range)
    
    Const MIPS_NUM_START_CHAR As Long = 6
    Dim tagRange As Range
    Dim order As Long
    Dim continue As Boolean
    
    For Each tagRange In MIPStags
        
        order = WholeNumber(tagRange.Characters.Text, MIPS_NUM_START_CHAR)
        Debug.Print order
        'carry on....
        
        
        
    Next
    
End Sub


'extract number from `txt`, beginning at `startChar`
'  return -1 if no number was found
Function WholeNumber(txt As String, ByVal startChar As Long) As Long
    Dim i As Long
    Do While Mid(txt, startChar + i, 1) Like "#"
        i = i + 1
    Loop
    If i > 0 Then 'at least one digit was found
        WholeNumber = CLng(Mid(txt, startChar, i))
    Else
        WholeNumber = -1 'no number found
    End If
End Function