MS Access – Auto Increment a Value

Have you ever needed to auto increment a revision number (ie:AZ -> BA or A1 -> A2)?

I can’t take credit for the following function, but knew it could help a lot of people. It works for AlphaNumeric value so it is very versatile compared to standard alpha incrementors. Once again, many thanks to both Graham Seach and Stefan Hoffman for sharing with us all!

Public Function IncrementAlphaNumCode(strCode As String) As String
'Author: Graham R Seach Microsoft Access MVP Sydney, Australia
'Source: http://social.answers.microsoft.com/Forums/en-US/addbuz/thread/6cc09fc4-4a58-4e5c-aa7d-d1cc36a5483c
'Based on code developed by Stefan Hoffman MVP
Dim lngASCII As Long
Dim lngCount As Long
Dim lngLength As Long
Dim strResult As String
Dim lngValues() As Long
Const BASE_DECIMAL As Long = 10
Const BASE_HEXAVIGESIMAL As Long = 26
Const BASE As Long = 0
Const VALUE As Long = 1
 
strCode = Trim(UCase(strCode))
lngLength = Len(strCode)
 
ReDim lngValues(lngLength, 1)
lngValues(lngLength, BASE) = BASE_DECIMAL
lngValues(lngLength, VALUE) = 0
 
'Decode to plain decimal
For lngCount = 0 To lngLength - 1
    lngASCII = Asc(Mid(strCode, lngLength - lngCount, 1))
    Select Case lngASCII
        Case 48 To 57 'Numeric digit, base 10, decimal
            lngValues(lngCount, BASE) = BASE_DECIMAL
            lngValues(lngCount, VALUE) = lngASCII - 48
        Case 65 To 90 'Alphabetical character, base 26, hexavigesimal (upper case)
            lngValues(lngCount, BASE) = BASE_HEXAVIGESIMAL
            lngValues(lngCount, VALUE) = lngASCII - 65
        Case Else 'Non-alphanumeric character
            Err.Raise vbObjectError + 512, "IncrementCode", "Invalid character in source string"
    End Select
Next lngCount    'Increment

lngValues(0, VALUE) = lngValues(0, VALUE) + 1    'Calculate the carry forward
For lngCount = 0 To lngLength - 1
    If lngValues(lngCount, VALUE) >= lngValues(lngCount, BASE) Then
        lngValues(lngCount, VALUE) = 0
        lngValues(lngCount + 1, VALUE) = lngValues(lngCount + 1, VALUE) + 1
    End If
Next lngCount
 
'Encode back to mixed decimal/hexavigesimal
strResult = ""
For lngCount = 0 To lngLength
    If lngCount = lngLength And lngValues(lngCount, VALUE) = 0 Then
        Exit For
    End If
    If lngValues(lngCount, BASE) = BASE_DECIMAL Then
        strResult = Chr(lngValues(lngCount, VALUE) + 48) & strResult
    Else
        strResult = Chr(lngValues(lngCount, VALUE) + 65) & strResult
    End If
Next lngCount
 
IncrementAlphaNumCode = strResult
End Function