'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
LinkBack URL
About LinkBacks
Latest version below. Haven't tested what happens if checksum digit = 10 on a mod 11.
Register To Reply
Bookmarks