Private Function CreateCheckDigit(ByVal strField As String) As String
Dim i As Integer
Dim t As Integer
Dim lngSumTotal As Long
Dim lngRemainder As Long
Dim intFieldLength As Integer
Dim arrField() As String
Dim arrMulti() As Integer
Dim arrSum() As Integer
Dim blnSet As Boolean
CreateCheckDigit = ""
' **** Set length of field in question ****
intFieldLength = Len(strField)
' **** Split field into array for easier manipulation ****
For i = 0 To intFieldLength - 1
ReDim Preserve arrField(i)
arrField(i) = Mid(strField, i + 1, 1)
Next
' **** Start Calculation ****
' **** Step 1 - Product of Digits * 1 or 2 ****
blnSet = False
For i = LBound(arrField) To UBound(arrField)
ReDim Preserve arrMulti(i)
If blnSet = False Then
arrMulti(i) = arrField(i) * 1
blnSet = True
Else
arrMulti(i) = arrField(i) * 2
blnSet = False
End If
Next
' **** Step 2 - Sum of the digits ****
For i = LBound(arrMulti) To UBound(arrMulti)
ReDim Preserve arrSum(i)
For t = 1 To Len(CStr(arrMulti(i)))
arrSum(i) = arrSum(i) + CInt(Mid(arrMulti(i), t, 1))
Next
Next
' **** Step 3 - Subtract sum total from the next highest multi. of 10 ****
For i = LBound(arrSum) To UBound(arrSum)
lngSumTotal = lngSumTotal + arrSum(i)
Next
' **** Divide sum by 10 to get the remainder ****
lngRemainder = lngSumTotal Mod 10
' **** Subtract remainder from 10 to get Check Digit ****
If lngRemainder > 0 Then
CreateCheckDigit = 10 - lngRemainder
Else
CreateCheckDigit = lngRemainder
End If
Erase arrSum
Erase arrField
Erase arrMulti
End Function