All pastes #135275 Raw Edit

foobar

public text v1 · immutable
#135275 ·published 2006-08-16 20:46 UTC
rendered paste body
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