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