Here is my attempt to recreate the Ruby programming language's succ() function in VBA. Succ is a generic function that will increment a string. I've also attached an example database.
succ()
public Returns the successor to
str. The successor is calculated by incrementing characters starting from the rightmost alphanumeric (or the rightmost character if there are no alphanumerics) in the string. Incrementing a digit always results in another digit, and incrementing a letter results in another letter of the same case. Incrementing nonalphanumerics uses the underlying character set’s collating sequence.
If the increment generates a “carry,” the character to the left of it is incremented. This process repeats until there is no carry, adding an additional character if necessary.
https://apidock.com/ruby/String/succ
Code:
Option Compare Database
Option Explicit
'succ increments an alphanumeric string, returns the (succ)essor to str
' this is my implementation of ruby's String.succ / String.next method
' it will only increment the right most group of alphanumeric characters
' it will add one character if necessary eg 2 char input "ZZ" becomes 3 chars "AAA"
' or "99" becomes "100".
' Numbers always increment to the next number, letters to the next letter.
' https://ruby-doc.org/core-2.3.1/String.html#method-i-next
Public Function succ(ByVal str) As Variant
On Error GoTo ErrHandler
Dim str_len As Integer 'input string's length
Dim i As Integer 'index as we loop through input string
Dim b As Byte 'ascii byte value of character we're evaluating
Dim b_prev As Byte 'ascii byte of last alphanumeric character evaluated
Dim carry As Boolean 'does the loop need to keep going?
str = " " & str 'insert space to trick for loop to behaving correctly when we have carry over after index = 1 and avoid extra error handling
str_len = Len(str)
b_prev = False
carry = True
For i = str_len To 1 Step -1 'Loop through the string backwards (right to left), i = current index of loop
b = Asc(Mid(str, i, 1)) 'b = the ascii value of the character at string index i
Select Case b
Case 65 To 90, 97 To 122, 48 To 57 'case if A to Z, a to z, or 0 to 1 (alphanumerics)
b = b + 1 'we found a alphanumeric so increment it
'If the increment needs to roll back then handle it. eg Z increments back to A
' if there is a roll back (or carry over) then we will need to continue the for loop to the next char
Select Case b
Case 91
b = 65 '=A
Case 123
b = 97 '=a
Case 58
b = 48 '=0 (zero)
Case Else
'There was no carry over, we're already almost done
carry = False
End Select
'replace the character at index i with the incremented value
Mid(str, i, 1) = Chr(b)
'if there was no carry over then we're done, exit loop. otherwise repeat process until no more carry overs
If Not carry Then Exit For Else b_prev = b
Case Else
'either we havn't hit an alphanumeric yet in our right to left scan
' - OR - we need to add an additional character. Eg given input string "9" increments and rolls back to "0" BUT
' we need to insert another character in this case so result equals "10", not just "0". Insert that char into
' the string here.
If b_prev Then 'we need to insert a new character
Select Case b_prev
Case 65 'A
b = 65
Case 97 'a
b = 97
Case 48 '0 (zero)
b = 49
End Select
str = Left(str, i) & Chr(b) & Right(str, str_len - i)
Exit For ' We are done
End If
End Select
Next i
'return results without the extra space we inserted at the beginning of the function
' recalcualte len(str) because we could have inserted another character since we started
succ = Right(str, Len(str) - 1)
ExitHandler:
Exit Function
ErrHandler:
Debug.Print "Error in 'succ' function. Error #" & Err.Number & ": " & Err.Description
succ = Err
Resume ExitHandler
End Function
SuccExample.accdb