One Digit Checksum

I've made my first attempt at making a number checksum creator/validation. After going round in circles, I've given up

Can some kind person please tell me where I've gone wrong with the below?

'140731
Option Explicit
Option Private Module

Private Const mbytcMod As Byte = 11

Public Sub TestMod11Checksum()
    Dim avarWeights() As Variant
    Dim strRegNo As String
    Dim bytCheckDigit As Byte
    Dim blnIsValidChecksum As Boolean

    avarWeights = Array(1, 4, 3, 7, 5, 8, 6, 9, 10)

    Debug.Print "Create random 8 digit string"
    strRegNo = Int(Rnd * 100000000#)
    Debug.Print "Random no. = " & strRegNo

    Debug.Print "Attempt calc of checksum digit for random no."
    bytCheckDigit = fn_bytCalcChecksumDigitMod11(strRegNo, avarWeights)
    Debug.Print "Check digit = " & bytCheckDigit

    Debug.Print "To test checksum validation works, we will add the check digit to the end of the 8 digit no. then run this through the function"
    strRegNo = strRegNo & bytCheckDigit
    Debug.Print "Random no. is now " & strRegNo

    blnIsValidChecksum = fn_blnValidChecksumMod11(strRegNo, avarWeights)

    Debug.Print "The checksum validation returned: " & blnIsValidChecksum
End Sub

Public Function fn_bytCalcChecksumDigitMod11(ByVal strChecksum As String, ByVal avarWeightFactors As Variant) As Byte
'provide the full weighting array - i.e. include the weight for the checksum digit
    Dim bytPosition     As Byte
    Dim intSum          As Integer
    Dim bytCurrent      As Byte
    Dim blnValid        As Boolean
    Dim bytWeight       As Byte
    Dim bytArrOptFix    As Byte
    Dim bytRemainder    As Byte
    Dim intCheckDigit   As Integer

    If Not IsNumeric(strChecksum) Then
        Exit Function
    End If

    If Not IsArray(avarWeightFactors) Then
        Exit Function
    End If

    If Not Len(strChecksum) = UBound(avarWeightFactors) - LBound(avarWeightFactors) Then
        Exit Function
    End If

    'auto handle base0 and base1 arrays
    bytArrOptFix = 1 - LBound(avarWeightFactors)

    'Multiply each digit by its weighting factor
    For bytPosition = 1 To Len(strChecksum) - 1

        'get the value of the current digit
        bytCurrent = CInt(Mid(strChecksum, bytPosition, 1))

        'get the value of the current weight factor
        bytWeight = avarWeightFactors(bytPosition - bytArrOptFix)

        'add the multiplied value to the total sum
        intSum = intSum + (bytWeight * bytCurrent)
    Next bytPosition



    'I'm dubious about the next few lines of code
    Select Case intSum
    Case Is < mbytcMod
        intCheckDigit = mbytcMod - intSum
    Case Is = mbytcMod
        intCheckDigit = 0
    Case Is > mbytcMod
        bytRemainder = intSum Mod mbytcMod

        If bytRemainder = 0 Then
            intCheckDigit = 0
        ElseIf bytRemainder > 0 Then
            intCheckDigit = ((bytRemainder + 1) * mbytcMod) - intSum
        Else
            Debug.Assert False
            'shouldn't reach here?
        End If
    End Select

    fn_bytCalcChecksumDigitMod11 = intCheckDigit
End Function

Public Function fn_blnValidChecksumMod11(ByVal strChecksum As String, ByVal avarWeightFactors As Variant) As Boolean
    Dim bytPosition     As Byte
    Dim intSum          As Integer
    Dim bytCurrent      As Byte
    Dim blnValid        As Boolean
    Dim bytWeight       As Byte
    Dim bytArrOptFix    As Byte

    If Not IsNumeric(strChecksum) Then
        Exit Function
    End If

    If Not IsArray(avarWeightFactors) Then
        Exit Function
    End If

    If Not Len(strChecksum) = UBound(avarWeightFactors) - LBound(avarWeightFactors) + 1 Then
        Exit Function
    End If

    'auto handle base0 and base1 arrays
    bytArrOptFix = 1 - LBound(avarWeightFactors)

    'Multiply each digit by its weighting factor
    For bytPosition = 1 To Len(strChecksum)

        'get the value of the current digit
        bytCurrent = CInt(Mid(strChecksum, bytPosition, 1))

        'get the value of the current weight factor
        bytWeight = avarWeightFactors(bytPosition - bytArrOptFix)

        'add the multiplied value to the total sum
        intSum = intSum + (bytWeight * bytCurrent)
    Next bytPosition

    'If total is exactly divisible by mod factor then checksum is valid
    blnValid = (intSum Mod mbytcMod = 0)

    fn_blnValidChecksumMod11 = blnValid
End Function

Can you please describe how the behavior of this code is different than the behavior you want? This is a lot of code to sift through cold.

Originally Posted by 6StringJazzer

Can you please describe how the behavior of this code is different than the behavior you want? This is a lot of code to sift through cold.

Sorry my fault. I thought the Debug.Print messages in the first sub were sufficient.


If you run the TestMod11Checksum sub (just a sub for testing the 2 functions in the module), the final debug.print should print "The checksum validation returned: True". But it keeps printing "The checksum validation returned: False".


The test sub creates a random number, it then runs it through the first function to create a checksum digit for this number. The checksum digit is added to the end of the random number and then run through the 2nd function which is meant to validate the checksum digit. But this function keeps returning false as I said.

So somehow the two functions must not be compatible with each other. But I can't work out where.

Originally Posted by 6StringJazzer

Very helpful, thanks.

When I run this code I get an overflow error on this line, with the right side equal to -53.

    fn_bytCalcChecksumDigitMod11 = intCheckDigit

Debug output to that point is

Create random 8 digit string
Random no. = 70554751
Attempt calc of checksum digit for random no.

Will continue to investigate.

My fault again. I have a bad habit of keeping variables as tight as possible. Too tight. Byte doesn't handle negatives. So I had to change it to integer.

The normal method is to return 11 - bytRemainder as the check digit, but if you use Mod 11, the result can be 10, so you'd use a letter like X instead (and your validation function needs to convert this back to 10 when performing its calculations).

Originally Posted by romperstomper

The normal method is to return 11 - bytRemainder as the check digit, but if you use Mod 11, the result can be 10, so you'd use a letter like X instead (and your validation function needs to convert this back to 10 when performing its calculations).

I did briefly read mod11 algorithms a while ago and I don't recall seeing any mention of requiring a checksum letter instead of a digit. I will have to investigate further.

Here's the latest version. Still not working.

'140801
Option Explicit
'Option Private Module

Public Sub TestChecksum()
'sub for testing the checksum functions on this module

    '__used for calc/validate__
    Dim bytModFactor As Byte
    Dim avarWeights() As Variant
    
    '__this will be user entry in final version__
    Dim strRegNo As String
    
    '__results__
    Dim bytCheckDigit As Byte
    Dim blnIsValidChecksum As Boolean

    Call UseRandomData(bytModFactor, avarWeights, strRegNo)


    Debug.Print "Reg. no. = " & strRegNo

    Debug.Print "Attempt calc of checksum digit for reg no."
    bytCheckDigit = fn_bytCalcChecksumDigitMod11(bytModFactor, strRegNo, avarWeights)
    Debug.Print "Check digit = " & bytCheckDigit


    Debug.Print "To test checksum validation works, we will add the check digit to the end of the reg no. then run this through the function"
    strRegNo = strRegNo & bytCheckDigit
    Debug.Print "Reg no. is now " & strRegNo


    blnIsValidChecksum = fn_blnValidChecksumMod11(bytModFactor, strRegNo, avarWeights)


    Debug.Print "The checksum validation returned: " & blnIsValidChecksum
End Sub

Public Function fn_bytCalcChecksumDigitMod11(ByVal bytModF As Byte, ByVal strChecksum As String, ByVal avarWeightFactors As Variant) As Byte
'provide the full weighting array - i.e. include the weight for the checksum digit
    Dim bytPosition     As Byte
    Dim intSum          As Integer
    Dim bytCurrent      As Byte
    Dim blnValid        As Boolean
    Dim bytWeight       As Byte
    Dim bytArrOptFix    As Byte
    Dim bytRemainder    As Byte
    Dim intCheckDigit   As Integer

    If Not IsNumeric(strChecksum) Then
        Exit Function
    End If

    If Not IsArray(avarWeightFactors) Then
        Exit Function
    End If

    If Not Len(strChecksum) = UBound(avarWeightFactors) - LBound(avarWeightFactors) Then
        Exit Function
    End If

    'auto handle base0 and base1 arrays
    bytArrOptFix = 1 - LBound(avarWeightFactors)

    'Multiply each digit by its weighting factor
    For bytPosition = 1 To Len(strChecksum) - 1

        'get the value of the current digit
        bytCurrent = CInt(Mid(strChecksum, bytPosition, 1))

        'get the value of the current weight factor
        bytWeight = avarWeightFactors(bytPosition - bytArrOptFix)

        'add the multiplied value to the total sum
        intSum = intSum + (bytWeight * bytCurrent)
    Next bytPosition



    'I'm dubious about the next few lines of code
    Select Case intSum
    Case Is < bytModF
        intCheckDigit = bytModF - intSum
    Case Is = bytModF
        intCheckDigit = 0
    Case Is > bytModF
        bytRemainder = intSum Mod bytModF

        If bytRemainder = 0 Then
            intCheckDigit = 0
        ElseIf bytRemainder > 0 Then
            'i think the main problem is here. How do I return a numeral digit for mod 11?
            intCheckDigit = bytModF - bytRemainder
            'see comment in thread by romperstomper
        Else
            Debug.Assert False
            'shouldn't reach here?
        End If
    End Select

    fn_bytCalcChecksumDigitMod11 = intCheckDigit
End Function

Public Function fn_blnValidChecksumMod11(ByVal bytModF As Byte, ByVal strChecksum As String, ByVal avarWeightFactors As Variant) As Boolean
    Dim bytPosition     As Byte
    Dim intSum          As Integer
    Dim bytCurrent      As Byte
    Dim blnValid        As Boolean
    Dim bytWeight       As Byte
    Dim bytArrOptFix    As Byte

    If Not IsNumeric(strChecksum) Then
        Exit Function
    End If

    If Not IsArray(avarWeightFactors) Then
        Exit Function
    End If

    If Not Len(strChecksum) = UBound(avarWeightFactors) - LBound(avarWeightFactors) + 1 Then
        Exit Function
    End If

    'auto handle base0 and base1 arrays
    bytArrOptFix = 1 - LBound(avarWeightFactors)

    'Multiply each digit by its weighting factor
    For bytPosition = 1 To Len(strChecksum)

        'get the value of the current digit
        bytCurrent = CInt(Mid(strChecksum, bytPosition, 1))

        'get the value of the current weight factor
        bytWeight = avarWeightFactors(bytPosition - bytArrOptFix)

        'add the multiplied value to the total sum
        intSum = intSum + (bytWeight * bytCurrent)
    Next bytPosition

    'If total is exactly divisible by mod factor then checksum is valid
    blnValid = (intSum Mod bytModF = 0)

    fn_blnValidChecksumMod11 = blnValid
End Function

Private Sub UseRandomData(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String)
    Debug.Print "Create random 8 digit string"
    rstrRegNo = Int(Rnd * 100000000#)

    ravarWeights = Array(1, 4, 3, 7, 5, 8, 6, 9, 10)
    rbytModFactor = 11
End Sub

Private Sub UseEAN(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String)
    'EAN-13
    rstrRegNo = "890152620605"
    ravarWeights = Array(1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3)
    'rbytModFactor = ?
End Sub

It's now starting to come together. Latest version below. Haven't tested what happens if checksum digit = 10 on a mod 11.

'140801
Option Explicit

'functions now working for:
'   EAN-13 (mod 10, 1 digit checksum at end)
'   UPC (mod 10, 1 digit checksum at end)
'   ISSN (mod 11, 1 digit checksum at end)
'   ISBN13 (mod 10, 1 digit checksum at end)
'   ISBN10 (mod 11, 1 digit checksum at end)
'   USPS (mod 9, 1 digit checksum at end)
'   RTN (mod 10, 1 digit checksum at end)


'test data & formula logic taken from CodeProject page by Shine Jacob
' www.codeproject.com/Articles/459507/Identification-numbers-and-check-digit-algorithms


Public Sub TestChecksum()
'sub for testing the checksum functions on this module

    '__used for calc/validate__
    Dim bytModFactor As Byte
    Dim avarWeights() As Variant
    
    '__this will be user entry in final version__
    Dim strRegNo As String
    
    '__results__
    Dim intCheckDigit As Integer
    Dim blnIsValidChecksum As Boolean


    Call Test_RandomData(bytModFactor, avarWeights, strRegNo)
    'Call Test_RTN(bytModFactor, avarWeights, strRegNo)


    Debug.Print "Reg. no. = " & strRegNo

    Debug.Print "Attempt calc of checksum digit for reg no."
    intCheckDigit = fn_intChecksumDigit_Calc(bytModFactor, strRegNo, avarWeights)
    Debug.Print "Check digit = " & intCheckDigit

    'stop if checksum digit wasnt calculated
    Debug.Assert (Not intCheckDigit = -1)


    Debug.Print "To test checksum validation works, we will add the check digit to the end of the reg no. then run this through the function"
    strRegNo = strRegNo & intCheckDigit
    Debug.Print "Reg no. is now " & strRegNo


    blnIsValidChecksum = fn_blnChecksumDigit_Validate(bytModFactor, strRegNo, avarWeights)


    Debug.Print "The checksum validation returned: " & blnIsValidChecksum
End Sub

Public Function fn_intChecksumDigit_Calc(ByVal bytModF As Byte, ByVal strChecksum As String, ByVal avarWeightFactors As Variant) As Integer
    Dim bytPosition     As Byte
    Dim intSum          As Integer
    Dim bytCurrent      As Byte
    Dim blnValid        As Boolean
    Dim bytWeight       As Byte
    Dim bytArrOptFix    As Byte
    Dim bytRemainder    As Byte
    Dim intCheckDigit   As Integer

    'add bad default for error checking
    fn_intChecksumDigit_Calc = -1


'    If Not IsNumeric(strChecksum) Then
'        Exit Function
'    End If

    Call NumericCharactersOnly(strChecksum)

    If Not IsArray(avarWeightFactors) Then
        Exit Function
    End If
    
    'ensure no. array elements = no. of digits
    If Not Len(strChecksum) = UBound(avarWeightFactors) - LBound(avarWeightFactors) + 1 Then
        Exit Function
    End If

    'auto handle base0 and base1 arrays
    bytArrOptFix = 1 - LBound(avarWeightFactors)

    'Multiply each digit by its weighting factor
    For bytPosition = 1 To Len(strChecksum)

        'get the value of the current digit
        bytCurrent = CInt(Mid(strChecksum, bytPosition, 1))

        'get the value of the current weight factor
        bytWeight = avarWeightFactors(bytPosition - bytArrOptFix)

        'add the multiplied value to the total sum
        intSum = intSum + (bytWeight * bytCurrent)
    Next bytPosition


    '? the rest of the code varies depending on mod factor?
    Select Case bytModF
    Case 10, 11, 9
        bytRemainder = intSum Mod bytModF
        If bytRemainder = 0 Then
            intCheckDigit = 0
        Else
            intCheckDigit = bytModF - bytRemainder
        End If

    Case Else
'        'I'm dubious about the next few lines of code
'        Select Case intSum
'        Case Is < bytModF
'            intCheckDigit = bytModF - intSum
'        Case Is = bytModF
'            intCheckDigit = 0
'        Case Is > bytModF
'            bytRemainder = intSum Mod bytModF
'
'            If bytRemainder = 0 Then
'                intCheckDigit = 0
'            ElseIf bytRemainder > 0 Then
'                'i think the main problem is here. How do I return a numeral digit for mod 11?
'                intCheckDigit = bytModF - bytRemainder
'                'see comment in thread by romperstomper
'            Else
'                Debug.Assert False
'                'shouldn't reach here?
'            End If
'        End Select
    End Select

    fn_intChecksumDigit_Calc = intCheckDigit
End Function

Public Function fn_blnChecksumDigit_Validate(ByVal bytModF As Byte, ByVal strChecksum As String, ByVal avarWeightFactors As Variant) As Boolean
    Dim bytPosition     As Byte
    Dim intSum          As Integer
    Dim bytCurrent      As Byte
    Dim blnValid        As Boolean
    Dim bytWeight       As Byte
    Dim bytArrOptFix    As Byte


'    If Not IsNumeric(strChecksum) Then
'        Exit Function
'    End If

    Call NumericCharactersOnly(strChecksum)


    If Not IsArray(avarWeightFactors) Then
        Exit Function
    End If

    'ensure no. array elements = no. of digits LESS THE CHECKSUM DIGIT
    If Not Len(strChecksum) - 1 = UBound(avarWeightFactors) - LBound(avarWeightFactors) + 1 Then
        Exit Function
    End If

    'auto handle base0 and base1 arrays
    bytArrOptFix = 1 - LBound(avarWeightFactors)

    'Multiply each digit by its weighting factor
    '(excl. the checksum digit)
    For bytPosition = 1 To Len(strChecksum) - 1

        'get the value of the current digit
        bytCurrent = CInt(Mid(strChecksum, bytPosition, 1))

        'get the value of the current weight factor
        bytWeight = avarWeightFactors(bytPosition - bytArrOptFix)

        'add the multiplied value to the total sum
        intSum = intSum + (bytWeight * bytCurrent)
    Next bytPosition

    'now add the checksum digit to the sum
    intSum = intSum = Right(strChecksum, 1)

    'If total is exactly divisible by mod factor then checksum is valid
    blnValid = (intSum Mod bytModF = 0)


    fn_blnChecksumDigit_Validate = blnValid
End Function

Private Sub Test_RandomData(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String)
    Debug.Print "Create random 8 digit string"
    rstrRegNo = Int(Rnd * 100000000#)

    ravarWeights = Array(1, 4, 3, 7, 5, 8, 6, 9, 10)
    rbytModFactor = 11
End Sub

Private Sub Test_EAN13(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String)
'EAN-13
    rstrRegNo = "890152620605"
    ravarWeights = Array(1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3)
    rbytModFactor = 10
End Sub

Private Sub Test_LuhnFormula(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String)
    rstrRegNo = "7992739871"
    ravarWeights = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    rbytModFactor = 10
End Sub

Private Sub Test_UPC(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String)
    rstrRegNo = "03600029145"
    ravarWeights = Array(3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3)
    rbytModFactor = 10
End Sub

Private Sub Test_ISSN(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String)
    rstrRegNo = "0378595"
    ravarWeights = Array(8, 7, 6, 5, 4, 3, 2)
    rbytModFactor = 11
End Sub

Private Sub Test_ISBN13(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String)
    rstrRegNo = "987007063546"
    ravarWeights = Array(1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3)
    rbytModFactor = 10
End Sub

Private Sub Test_ISBN10(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String)
    rstrRegNo = "007063546"
    ravarWeights = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
    rbytModFactor = 11
End Sub

Private Sub Test_USPS(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String)
    rstrRegNo = "8431032502"
    ravarWeights = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    rbytModFactor = 9
End Sub

Private Sub Test_RTN(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String)
    rstrRegNo = "25407011"
    ravarWeights = Array(7, 3, 9, 7, 3, 9, 7, 3)
    rbytModFactor = 10
End Sub

Private Function NumericCharactersOnly(ByRef rstrText As String) As String
    Dim lngLoop     As Integer
    Dim strNums     As String

    For lngLoop = 1 To Len(rstrText)
        If IsNumeric(Mid(rstrText, lngLoop, 1)) Then
            strNums = strNums & Mid(rstrText, lngLoop, 1)
        End If
    Next lngLoop

    NumericCharactersOnly = strNums
End Function

making progress. now trying to allow the possibility of passing a negative number as an argument. I have a number of CRC32 checksums that I want to record with a 1 digit checksum to ensure their validity. However some of the CRC32 checksums are negative.

I think I have finished it. It now allows for negative serial number arguments and the option to use Luhn formula for mod10 checksums.

If anyone can see any error, please let me know where it is and I'll rep you for pointing it out.

'---------------------------------------------------------------------------------------
' Module    : t_Checksum
' Name      : 1 Digit Checksum
' Purpose   : Create or validate a 1 digit checksum
' Updated   : 05/08/2014
' Notes     :
'
'   now includes option to calculate mod10 using the Luhn algorithm
'   assumes checksum is 1 digit only (to do 2 digit checksum version another day)
'   assumes checksum is last digit
'
'   functions now working for the following serials/standards:
'       ACN (mod 10)(len=9)
'       EAN-13 (mod 10)(len=13)
'       IMEI (mod 10, use LUHN)(len=15)
'       ISBN-10 (mod 11)(len=10)
'       ISBN-13 (mod 10)(len=13)
'       ISSN (mod 11)(len=8)
'       RTN (mod 10)(len=9)
'       TFN-9 (mod 11)(len=9)
'       UPC (mod 10)(len=12)
'       USPS (mod 9)(len=11)
'
'   to validate the above standards, you need to know: a) the mod factor to use and b) the weighting array to use
'
'
' Credits/Acknowledgements:
'   Weighting info taken from CodeProject page by Shine Jacob
'   www.codeproject.com/Articles/459507/Identification-numbers-and-check-digit-algorithms
'
'
' Requirements:
'   Reference Library = N/A
'   Modules = N/A (NumericCharactersOnly copied from Strings template)
'---------------------------------------------------------------------------------------

Option Explicit

Public Sub TestChecksum()
'sub for testing the checksum functions on this module

    '__used for calc/validate__
    Dim bytModFactor As Byte
    Dim avarWeights() As Variant
    Dim blnIsLuhn As Boolean
    '__this will be function argument in final version__
    Dim strSerial As String
    '__results__
    Dim intCheckDigit As Integer
    Dim blnIsValidChecksum As Boolean



    'set input variables
    Call Test_RandomData(bytModFactor, avarWeights, strSerial)

    Debug.Print "Serial = " & strSerial

    Debug.Print "Attempt calc of checksum digit for serial"
    intCheckDigit = fn_intChecksumDigit_Calc(bytModFactor, strSerial, avarWeights, blnIsLuhn)
    Debug.Print "Check digit = " & intCheckDigit

    'stop if checksum digit was not calculated
    Debug.Assert (Not intCheckDigit = -1)

    Debug.Print "To test checksum validation works, add the check digit to the end of the serial then run it through the function"
    strSerial = strSerial & intCheckDigit
    Debug.Print "Serial now = " & strSerial

    blnIsValidChecksum = fn_blnChecksumDigit_Validate(bytModFactor, strSerial, avarWeights)

    Debug.Print "Checksum validation returned: " & blnIsValidChecksum
End Sub

Public Function fn_intChecksumDigit_LuhnCalc(ByVal strSerialNo As String) As Integer
'calculates a 1 digit checksum using the Luhn algorithm

    Dim intResult           As Integer
    Dim avarWeightFactors() As Variant
    Dim abytMax             As Byte

    'clean serial
    Call NumericCharactersOnly(strSerialNo)

    'detect if negative serial and adjust array size
    Select Case (Left(strSerialNo, 1) = "-")
    Case True
        abytMax = Len(strSerialNo) - 1
    Case False
        abytMax = Len(strSerialNo)
    End Select

    avarWeightFactors = fn_avarLuhnWeightingArray(abytMax)

    'run through checksum function
    intResult = fn_intChecksumDigit_Calc(bytModF:=10, strSerialNo:=strSerialNo, avarWeightFactors:=avarWeightFactors, blnMod10IsLuhn:=True)

    fn_intChecksumDigit_LuhnCalc = intResult
End Function

Public Function fn_intChecksumDigit_Calc(ByVal bytModF As Byte, _
                                        ByVal strSerialNo As String, _
                                        ByVal avarWeightFactors As Variant, _
                                        Optional ByVal blnMod10IsLuhn As Boolean) As Integer

    Dim bytPositionCnt  As Byte
    Dim bytNegOffset    As Byte
    Dim intSum          As Integer
    Dim intCurrent      As Integer
    Dim bytWeight       As Byte
    Dim bytArrBaseFix   As Byte
    Dim bytRemainder    As Byte
    Dim intCheckDigit   As Integer
    Dim bytLuhnDblCnt   As Byte
    Dim blnNegSerial    As Boolean


    'add 'bad' default for error checking
    fn_intChecksumDigit_Calc = -1

    'clean serial
    Call NumericCharactersOnly(strSerialNo)

    'handle negative serial
    blnNegSerial = (Left(strSerialNo, 1) = "-")
    If blnNegSerial = True Then
        bytNegOffset = 1
    End If

    'ensure weighting array is valid
    If Not IsArray(avarWeightFactors) Then
        Exit Function
    End If

    'no. of array elements must = no. of digits in serial argument (excl. any minus symbol)
    If Not Len(strSerialNo) - bytNegOffset = UBound(avarWeightFactors) - LBound(avarWeightFactors) + 1 Then
        Exit Function
    End If

    'prevent user error - asking for Luhn on a non-Mod10
    blnMod10IsLuhn = ((blnMod10IsLuhn = True) And (bytModF = 10))

    'handle base0 and base1 arrays
    bytArrBaseFix = 1 - LBound(avarWeightFactors)


    'Multiply each digit by its weighting factor
    For bytPositionCnt = 1 To Len(strSerialNo)

        If blnNegSerial = True And (bytPositionCnt = 1 Or bytPositionCnt = 2) Then
            'do nothing
        Else
            'get the value of the current digit
            intCurrent = CInt(Mid(strSerialNo, bytPositionCnt - bytNegOffset, 1))

            If blnNegSerial = True And bytPositionCnt = 3 Then
                intCurrent = 0 - intCurrent
                'convert the first numeral to negative
            End If

            'get the value of the current weight factor
            bytWeight = avarWeightFactors(bytPositionCnt - bytNegOffset - bytArrBaseFix)

            'add the multiplied value to the total sum
            intCurrent = (bytWeight * intCurrent)

            'this records the two digit results (which we need later if using Luhn)
            Select Case intCurrent
            Case -9 To 9
                'do nothing
            Case Is > 9
                bytLuhnDblCnt = bytLuhnDblCnt + 1
            Case Is < -9
                bytLuhnDblCnt = bytLuhnDblCnt - 1
            End Select

            intSum = intSum + intCurrent
        End If
    Next bytPositionCnt


    'if using Luhn then add the digits to each other if doubling caused a 2 digit result
    If blnMod10IsLuhn = True Then
        intSum = intSum - (bytLuhnDblCnt * 9)
        '(the above calc method works due to 'casting out nines')
    End If


    bytRemainder = intSum Mod bytModF
    If bytRemainder = 0 Then
        intCheckDigit = 0
    Else
        intCheckDigit = bytModF - bytRemainder

        If intCheckDigit = 10 Then
            intCheckDigit = 0
        End If
    End If

    fn_intChecksumDigit_Calc = intCheckDigit
End Function

Public Function fn_blnChecksumDigit_LuhnValidate(ByVal strSerialNo As String) As Boolean
'/ Validates a 1 digit checksum in a serial number using the Luhn algorithm
'/ main difference to the other function is that creates the weighting array - useful if serial no. len could vary

    Dim avarWeightFactors() As Variant
    Dim abytMax             As Byte
    Dim blnResult           As Boolean

    'clean serial
    Call NumericCharactersOnly(strSerialNo)

    'detect if negative serial and adjust array size
    Select Case (Left(strSerialNo, 1) = "-")
    Case True
        abytMax = Len(strSerialNo) - 1
    Case False
        abytMax = Len(strSerialNo)
    End Select

    avarWeightFactors = fn_avarLuhnWeightingArray(abytMax)

    'run through checksum function
    blnResult = fn_blnChecksumDigit_Validate(bytModF:=10, strSerialNo:=strSerialNo, avarWeightFactors:=avarWeightFactors)

    fn_blnChecksumDigit_LuhnValidate = blnResult
End Function

Private Function fn_avarLuhnWeightingArray(ByVal bytElementsCnt As Byte) As Variant
    Dim avarWeightFactors() As Variant
    Dim aintLoopCnt         As Integer

    ReDim avarWeightFactors(1 To bytElementsCnt)

    'populate the weighting array
    For aintLoopCnt = LBound(avarWeightFactors) To UBound(avarWeightFactors)
        If ((aintLoopCnt Mod 2) = 0) Then
            avarWeightFactors(aintLoopCnt) = 2
        Else
            avarWeightFactors(aintLoopCnt) = 1
        End If
    Next aintLoopCnt

    fn_avarLuhnWeightingArray = avarWeightFactors
End Function

Public Function fn_blnChecksumDigit_Validate(ByVal bytModF As Byte, ByVal strSerialNo As String, ByVal avarWeightFactors As Variant) As Boolean

    Const bytcCSlen     As Byte = 1 'only permitting 1 digit checksum
    Dim bytPositionCnt  As Byte
    Dim intSum          As Integer
    Dim intCurrent      As Integer
    Dim blnValid        As Boolean
    Dim bytWeight       As Byte
    Dim bytArrBaseFix   As Byte
    Dim blnNegSerial    As Boolean
    Dim bytNegOffset    As Byte

    Call NumericCharactersOnly(strSerialNo)

    If Not IsArray(avarWeightFactors) Then
        Exit Function
    End If

    'handle negative serial
    blnNegSerial = (Left(strSerialNo, 1) = "-")
    If blnNegSerial = True Then
        bytNegOffset = 1
    End If

    'ensure no. array elements = no. of digits LESS THE CHECKSUM DIGIT
    If Not Len(strSerialNo) - bytcCSlen - bytNegOffset = UBound(avarWeightFactors) - LBound(avarWeightFactors) + 1 Then
        Exit Function
    End If

    'handle base0 and base1 arrays
    bytArrBaseFix = 1 - LBound(avarWeightFactors)

    'Multiply each digit by its weighting factor
    '(excl. the checksum digit)
    For bytPositionCnt = 1 To Len(strSerialNo) - bytcCSlen

        If blnNegSerial = True And (bytPositionCnt = 1 Or bytPositionCnt = 2) Then
            'do nothing
        Else
            'get the value of the current digit
            intCurrent = CInt(Mid(strSerialNo, bytPositionCnt - bytNegOffset, 1))

            If blnNegSerial = True And bytPositionCnt = 3 Then
                intCurrent = 0 - intCurrent
                'convert the first numeral to negative
            End If

            'get the value of the current weight factor
            bytWeight = avarWeightFactors(bytPositionCnt - bytNegOffset - bytArrBaseFix)

            'add the multiplied value to the total sum
            intSum = intSum + (bytWeight * intCurrent)
        End If
    Next bytPositionCnt

    'now add the checksum digit to the sum
    intSum = intSum = Right(strSerialNo, bytcCSlen)

    'If total is exactly divisible by mod factor then checksum is valid
    blnValid = (intSum Mod bytModF = 0)

    fn_blnChecksumDigit_Validate = blnValid
End Function

Private Sub Test_RandomData(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String, Optional ByRef blnIsLuhn As Boolean)
    Debug.Print "Create random 8 digit string"
    rstrRegNo = Format(Int(Rnd * 100000000#), "00000000")

    ravarWeights = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
    rbytModFactor = 11
    blnIsLuhn = False
End Sub

Private Sub Test_EAN13(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String, Optional ByRef blnIsLuhn As Boolean)
    rstrRegNo = "890152620605"
    ravarWeights = Array(1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3)
    rbytModFactor = 10
    blnIsLuhn = False
End Sub

Private Sub Test_UPC(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String, Optional ByRef blnIsLuhn As Boolean)
    rstrRegNo = "03600029145"
    ravarWeights = Array(3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3)
    rbytModFactor = 10
    blnIsLuhn = False
End Sub

Private Sub Test_ISSN(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String, Optional ByRef blnIsLuhn As Boolean)
    rstrRegNo = "0378595"
    ravarWeights = Array(8, 7, 6, 5, 4, 3, 2)
    rbytModFactor = 11
    blnIsLuhn = False
End Sub

Private Sub Test_ISBN13(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String, Optional ByRef blnIsLuhn As Boolean)
    rstrRegNo = "987007063546"
    ravarWeights = Array(1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3)
    rbytModFactor = 10
    blnIsLuhn = False
End Sub

Private Sub Test_ISBN10(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String, Optional ByRef blnIsLuhn As Boolean)
    rstrRegNo = "007063546"
    ravarWeights = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
    rbytModFactor = 11
    blnIsLuhn = False
End Sub

Private Sub Test_USPS(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String, Optional ByRef blnIsLuhn As Boolean)
    rstrRegNo = "8431032502"
    ravarWeights = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    rbytModFactor = 9
    blnIsLuhn = False
End Sub

Private Sub Test_RTN(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String, Optional ByRef blnIsLuhn As Boolean)
    rstrRegNo = "25407011"
    ravarWeights = Array(7, 3, 9, 7, 3, 9, 7, 3)
    rbytModFactor = 10
    blnIsLuhn = False
End Sub

Private Sub Test_Luhn(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String, Optional ByRef blnIsLuhn As Boolean)
    rstrRegNo = "7992739871"
    ravarWeights = Array(1, 2, 1, 2, 1, 2, 1, 2, 1, 2)
    rbytModFactor = 10
    blnIsLuhn = True
End Sub

Private Sub Test_IMEI(ByRef rbytModFactor As Byte, ByRef ravarWeights As Variant, ByRef rstrRegNo As String, Optional ByRef blnIsLuhn As Boolean)
    Debug.Print "Create random 15 digit string"
    rstrRegNo = Format(CDbl(Rnd * 1E+15), "000000000000000")
    ravarWeights = Array(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1)
    rbytModFactor = 10
    blnIsLuhn = True
End Sub

Private Sub NumericCharactersOnly(ByRef rstrText As String)
    Dim intLoop     As Integer
    Dim strNums     As String

    'strip spaces
    rstrText = Application.WorksheetFunction.Trim(rstrText)

    'remove all non-numeric characters except for minus prefix
    For intLoop = 1 To Len(rstrText)
        If IsNumeric(Mid(rstrText, intLoop, 1)) Then
            strNums = strNums & Mid(rstrText, intLoop, 1)
        ElseIf intLoop = 1 Then
            'allow negative prefix
            If Left(rstrText, 1) = "-" Then
                strNums = "-"
            End If
        End If
    Next intLoop

    rstrText = strNums
End Sub

I discovered an error the next day. Have finally got round to posting the corrected code.

'---------------------------------------------------------------------------------------
' Module    : t_Checksum
' Name      : 1 Digit Checksum
' Purpose   : Create or validate a 1 digit checksum
' Updated   : 06/08/2014
' Notes     :
'
'   now includes option to calculate mod10 using the Luhn algorithm
'   assumes checksum is 1 digit only (to do 2 digit checksum version another day)
'   assumes checksum is last digit
'
'   functions tested as working for the following serials/standards:
'       ACN (mod 10)(len=9)
'       EAN-13 (mod 10)(len=13)
'       IMEI (mod 10, use LUHN)(len=15)
'       ISBN-10 (mod 11)(len=10)
'       ISBN-13 (mod 10)(len=13)
'       ISSN (mod 11)(len=8)
'       RTN (mod 10)(len=9)
'       TFN-9 (mod 11)(len=9)
'       UPC (mod 10)(len=12)
'       USPS (mod 9)(len=11)
'
'   to validate the above standards, you need to know: a) the mod factor to use and b) the weighting array to use
'
'
' Credits/Acknowledgements:
'   Weighting info taken from CodeProject page by Shine Jacob
'   www.codeproject.com/Articles/459507/Identification-numbers-and-check-digit-algorithms
'
'
' Requirements:
'   Reference Library = N/A
'   Modules = N/A (NumericCharactersOnly copied from Strings template)
'---------------------------------------------------------------------------------------

Option Explicit
Option Private Module

Public Function fn_intChecksumDigit_Calc(ByVal bytModF As Byte, _
                                        ByVal strSerialNo As String, _
                                        ByVal avarWeightFactors As Variant, _
                                        Optional ByVal blnMod10IsLuhn As Boolean) As Integer

    Dim bytPositionCnt  As Byte
    Dim bytNegOffset    As Byte
    Dim intSum          As Integer
    Dim intCurrent      As Integer
    Dim bytWeight       As Byte
    Dim bytArrBaseFix   As Byte
    Dim bytRemainder    As Byte
    Dim intCheckDigit   As Integer
    Dim bytLuhnDblCnt   As Byte
    Dim blnNegSerial    As Boolean


    'add 'bad' default for error checking
    fn_intChecksumDigit_Calc = -1

    'clean serial
    Call NumericCharactersOnly(strSerialNo)

    'handle negative serial
    blnNegSerial = (Left(strSerialNo, 1) = "-")
    If blnNegSerial = True Then
        bytNegOffset = 1
    End If

    'ensure weighting array is valid
    If Not IsArray(avarWeightFactors) Then
        Exit Function
    End If

    'no. of array elements must = no. of digits in serial argument (excl. any minus symbol)
    If Not Len(strSerialNo) - bytNegOffset = UBound(avarWeightFactors) - LBound(avarWeightFactors) + 1 Then
        Exit Function
    End If

    'prevent user error - asking for Luhn on a non-Mod10
    blnMod10IsLuhn = ((blnMod10IsLuhn = True) And (bytModF = 10))

    'handle base0 and base1 arrays
    bytArrBaseFix = 1 - LBound(avarWeightFactors)


    'Multiply each digit by its weighting factor
    For bytPositionCnt = 1 To Len(strSerialNo)

        If blnNegSerial = True And (bytPositionCnt = 1 Or bytPositionCnt = 2) Then
            'do nothing
        Else
            'get the value of the current digit
            intCurrent = CInt(Mid(strSerialNo, bytPositionCnt - bytNegOffset, 1))

            If blnNegSerial = True And bytPositionCnt = 3 Then
                intCurrent = 0 - intCurrent
                'convert the first numeral to negative
            End If

            'get the value of the current weight factor
            bytWeight = avarWeightFactors(bytPositionCnt - bytNegOffset - bytArrBaseFix)

            'add the multiplied value to the total sum
            intCurrent = (bytWeight * intCurrent)

            'this records the two digit results (which we need later if using Luhn)
            Select Case intCurrent
            Case -9 To 9
                'do nothing
            Case Is > 9
                bytLuhnDblCnt = bytLuhnDblCnt + 1
            Case Is < -9
                bytLuhnDblCnt = bytLuhnDblCnt - 1
            End Select

            intSum = intSum + intCurrent
        End If
    Next bytPositionCnt


    'if using Luhn then add the digits to each other if doubling caused a 2 digit result
    If blnMod10IsLuhn = True Then
        intSum = intSum - (bytLuhnDblCnt * 9)
        '(the above calc method works due to 'casting out nines')
    End If


    bytRemainder = intSum Mod bytModF
    If bytRemainder = 0 Then
        intCheckDigit = 0
    Else
        intCheckDigit = bytModF - bytRemainder

        If intCheckDigit = 10 Then
            intCheckDigit = 0
        End If
    End If

    fn_intChecksumDigit_Calc = intCheckDigit
End Function

Public Function fn_blnChecksumDigit_Validate(ByVal bytModF As Byte, ByVal strSerialNo As String, ByVal avarWeightFactors As Variant) As Boolean

    Const bytcCSlen     As Byte = 1 'only permitting 1 digit checksum
    Dim bytPositionCnt  As Byte
    Dim intSum          As Integer
    Dim intCurrent      As Integer
    Dim blnValid        As Boolean
    Dim bytWeight       As Byte
    Dim bytArrBaseFix   As Byte
    Dim blnNegSerial    As Boolean
    Dim bytNegOffset    As Byte

    Call NumericCharactersOnly(strSerialNo)

    If Not IsArray(avarWeightFactors) Then
        Exit Function
    End If

    'handle negative serial
    blnNegSerial = (Left(strSerialNo, 1) = "-")
    If blnNegSerial = True Then
        bytNegOffset = 1
    End If

    'ensure no. array elements = no. of digits LESS THE CHECKSUM DIGIT
    If Not Len(strSerialNo) - bytcCSlen - bytNegOffset = UBound(avarWeightFactors) - LBound(avarWeightFactors) + 1 Then
        Exit Function
    End If

    'handle base0 and base1 arrays
    bytArrBaseFix = 1 - LBound(avarWeightFactors)

    'Multiply each digit by its weighting factor
    '(excl. the checksum digit)
    For bytPositionCnt = 1 To Len(strSerialNo) - bytcCSlen

        If blnNegSerial = True And (bytPositionCnt = 1 Or bytPositionCnt = 2) Then
            'do nothing
        Else
            'get the value of the current digit
            intCurrent = CInt(Mid(strSerialNo, bytPositionCnt - bytNegOffset, 1))

            If blnNegSerial = True And bytPositionCnt = 3 Then
                intCurrent = 0 - intCurrent
                'convert the first numeral to negative
            End If

            'get the value of the current weight factor
            bytWeight = avarWeightFactors(bytPositionCnt - bytNegOffset - bytArrBaseFix)

            'add the multiplied value to the total sum
            intSum = intSum + (bytWeight * intCurrent)
        End If
    Next bytPositionCnt

    'now add the checksum digit to the sum
    intSum = intSum = Right(strSerialNo, bytcCSlen)

    'If total is exactly divisible by mod factor then checksum is valid
    blnValid = (intSum Mod bytModF = 0)

    fn_blnChecksumDigit_Validate = blnValid
End Function

Public Function fn_intChecksumDigit_LuhnCalc(ByVal strSerialNo As String) As Integer
'calculates a 1 digit checksum using the Luhn algorithm

    Dim intResult           As Integer
    Dim avarWeightFactors() As Variant
    Dim abytMax             As Byte

    'clean serial
    Call NumericCharactersOnly(strSerialNo)

    'detect if negative serial and adjust array size
    Select Case (Left(strSerialNo, 1) = "-")
    Case True
        abytMax = Len(strSerialNo) - 1
    Case False
        abytMax = Len(strSerialNo)
    End Select

    avarWeightFactors = fn_avarLuhnWeightingArray(abytMax)

    'run through checksum function
    intResult = fn_intChecksumDigit_Calc(bytModF:=10, strSerialNo:=strSerialNo, avarWeightFactors:=avarWeightFactors, blnMod10IsLuhn:=True)

    fn_intChecksumDigit_LuhnCalc = intResult
End Function

Public Function fn_blnChecksumDigit_LuhnValidate(ByVal strSerialNo As String) As Boolean
'/ Validates a 1 digit checksum in a serial number using the Luhn algorithm
'/ main difference to the other function is that creates the weighting array - useful if serial no. len could vary

    Dim avarWeightFactors() As Variant
    Dim abytMax             As Byte
    Dim blnResult           As Boolean
    Const bytcCSlen         As Byte = 1 'only permitting 1 digit checksum

    'clean serial
    Call NumericCharactersOnly(strSerialNo)

    'detect if negative serial and adjust array size
    Select Case (Left(strSerialNo, 1) = "-")
    Case True
        abytMax = Len(strSerialNo) - bytcCSlen - 1
    Case False
        abytMax = Len(strSerialNo) - bytcCSlen
    End Select

    avarWeightFactors = fn_avarLuhnWeightingArray(abytMax)

    'run through checksum function
    blnResult = fn_blnChecksumDigit_Validate(bytModF:=10, strSerialNo:=strSerialNo, avarWeightFactors:=avarWeightFactors)

    fn_blnChecksumDigit_LuhnValidate = blnResult
End Function

Private Function fn_avarLuhnWeightingArray(ByVal bytElementsCnt As Byte) As Variant
    Dim avarWeightFactors() As Variant
    Dim aintLoopCnt         As Integer

    ReDim avarWeightFactors(1 To bytElementsCnt)

    'populate the weighting array
    For aintLoopCnt = LBound(avarWeightFactors) To UBound(avarWeightFactors)
        If ((aintLoopCnt Mod 2) = 0) Then
            avarWeightFactors(aintLoopCnt) = 2
        Else
            avarWeightFactors(aintLoopCnt) = 1
        End If
    Next aintLoopCnt

    fn_avarLuhnWeightingArray = avarWeightFactors
End Function

Private Sub NumericCharactersOnly(ByRef rstrText As String, Optional ByVal blnAllowNegative As Boolean = True)
    Dim intLoop     As Integer
    Dim strNums     As String

    'strip spaces
    rstrText = Application.WorksheetFunction.Trim(rstrText)

    'remove all non-numeric characters except for minus prefix
    For intLoop = 1 To Len(rstrText)
        If IsNumeric(Mid(rstrText, intLoop, 1)) Then
            strNums = strNums & Mid(rstrText, intLoop, 1)
        ElseIf intLoop = 1 And blnAllowNegative = True Then
            'allow negative prefix
            If Left(rstrText, 1) = "-" Then
                strNums = "-"
            End If
        End If
    Next intLoop

    rstrText = strNums
End Sub