CheckDigit (1 Viewer)

Niranjeen

Registered User.
Local time
Today, 10:33
Joined
Nov 16, 2007
Messages
24
Need help with the current function:

I am working on generating a CheckDigit for a field.

The process is simple but yet iam not able to go around it, my head is not functioning at this point. Let me explain the process - If the Field is a name then, I am required to use the 3 weight-method using 7, 3, 1. The first char is multiplied with 7, then second char with 3, and third char with 1, the pattern is repeated till the last char. Then the sum of the product is divided by 10 to get a reminder. That reminder is the checkdigit.

Example:
Field hold "NIRAN"
Asc(N) * 7 = 78*7= 546
Asc(I) * 3 = 73*3= 219
Asc(R) * 1 = 82*1= 82
Asc(A) * 7 = 65*7= 455
Asc(N) * 3 = 78*3= 234
Total Product = 1546
CheckDigit = 1546 Mod 10 = 6

So I tried to Create a Public Function to be called:

Public Function DC(Strg As String)

Dim uStrg As String
Dim strLen As Integer
Dim tSum As Integer
Dim i, j, k As Integer

uStrg = ucase(Strg)

tSum = 0
For i = 1 To Len(uStrg)
tSum = tSum + (Asc(i) * 7)
For j = 1 To Len(uStrg) Step 2
tSum = tSum + (Asc(j) * 3)
For k = 1 To Len(Strg) Step 2
tSum = tSum + (Asc(k) * 1)
Next k
Next j
Next i
DC = tSum Mod 10
End Function
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 07:33
Joined
Aug 30, 2003
Messages
36,118
I don't think your loops are doing what you expect, though I think I know where you were trying to go. If there's a reasonable limit on the number of characters, I might use a single loop on the length of the string and use Select/Case to handle which multiplier to use. Conceptually:

Code:
Select Case i
  Case 1,4,7
  Case 2,5,8
  Case 3,6,9
End Select

You could also increment a variable inside the loop and reset it after 3.
 

Niranjeen

Registered User.
Local time
Today, 10:33
Joined
Nov 16, 2007
Messages
24
Yes there could be more than nine char or digit in the field.
 

MarkK

bit cruncher
Local time
Today, 07:33
Joined
Mar 17, 2004
Messages
8,178
Well, one little known thing you can do with a string is assign it directly to a byte array, and in this case we'll StrConv() it from Unicode, since Unicode uses two bytes for each char, so consider . . .
Code:
Private Sub Test1084371049()
    Dim bytes() As Byte
    Dim var
    
    bytes = StrConv("NIRAN", vbFromUnicode)
    For Each var In bytes
        Debug.Print var
    Next
End Sub
So, as a start, there's an easy way to get your Ascii values, and control your loop.
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 07:33
Joined
Aug 30, 2003
Messages
36,118
Yes there could be more than nine char or digit in the field.

It's easy enough to add values to the Case statements. Or if that becomes unwieldy like I said you can increment a variable within a loop of the string, test it for 1-2-3 and use the appropriate multiplier, and reset the variable after 3.
 

Niranjeen

Registered User.
Local time
Today, 10:33
Joined
Nov 16, 2007
Messages
24
If using the 123 incremental process, doesn't it again begin from the first char if the string? I should try it anyways.
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 07:33
Joined
Aug 30, 2003
Messages
36,118
No, I'm talking about a separate variable from the loop counter.
 

Cronk

Registered User.
Local time
Tomorrow, 01:33
Joined
Jul 4, 2013
Messages
2,770
The test has to be 1 2 3 4 5 6

for i = 1 to len(str)
select case i mod 6
case 1
lngRunningSum = lngRunningSum + asc(mid(str,i,1)) * 7
case 2
lngRunningSum = lngRunningSum + asc(mid(str,i,1)) * 3
case 3
lngRunningSum = lngRunningSum + asc(mid(str,i,1)) * 1
case 4
lngRunningSum = lngRunningSum + asc(mid(str,i,1)) * 1
case 5
lngRunningSum = lngRunningSum + asc(mid(str,i,1)) * 3
case 0
lngRunningSum = lngRunningSum + asc(mid(str,i,1)) * 7
end select
next i

Could be made a bit more elegant by putting the multiplying factors in an array.
 

Niranjeen

Registered User.
Local time
Today, 10:33
Joined
Nov 16, 2007
Messages
24
Well this is the where iam now.
Public Function DC(Strg As String)

Dim uStrg As String
Dim strLen As Integer
Dim ChVal As Integer
Dim tSum As Integer
Dim x As Integer

uStrg = ucase(Strg)
tSum = 0
x = 0
For x = 1 To Len(uStrg)
tSum = tSum + (AscW(Mid(uStrg, x, 1)) * 7)
x = x + 1
tSum = tSum + (AscW(Mid(uStrg, x, 1)) * 3)
x = x + 1
tSum = tSum + (AscW(Mid(uStrg, x, 1)) * 1)
Next x
DC = tSum Mod 10
End Function

PBladly: I suppose this should work. Logically is looks good to me.
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 07:33
Joined
Aug 30, 2003
Messages
36,118
I would test it before relying on it. ;)

Hint, what happens if your "x=x+1" puts the counter beyond the length of the string?
 

Niranjeen

Registered User.
Local time
Today, 10:33
Joined
Nov 16, 2007
Messages
24
Yeah, then I need to counter check if the Len() condition is met before the "x=x+1" statement.

Goodone, thanks I am close to it now.
 

Niranjeen

Registered User.
Local time
Today, 10:33
Joined
Nov 16, 2007
Messages
24
I am lost, that doesn't help me. The exit from FOR Loop is only NEXT? Is there a possibility to use while loop in this scenario?
 

Niranjeen

Registered User.
Local time
Today, 10:33
Joined
Nov 16, 2007
Messages
24
Well, one little known thing you can do with a string is assign it directly to a byte array, and in this case we'll StrConv() it from Unicode, since Unicode uses two bytes for each char, so consider . . .
Code:
Private Sub Test1084371049()
    Dim bytes() As Byte
    Dim var
    
    bytes = StrConv("NIRAN", vbFromUnicode)
    For Each var In bytes
        Debug.Print var
    Next
End Sub
So, as a start, there's an easy way to get your Ascii values, and control your loop.

Thanks for your response, I could use this concept to store ascii value to the char, right?
 

MarkK

bit cruncher
Local time
Today, 07:33
Joined
Mar 17, 2004
Messages
8,178
Does this solve it?
Code:
Private m_multiplier As Integer

Private Sub TestCheckDigit()
    Debug.Print CheckDigit("NIRAN")
End Sub

Public Function CheckDigit(Text As String) As Integer
    Dim bytes() As Byte
    Dim var
    Dim sum As Long

    m_multiplier = 1
    bytes = StrConv(Text, vbFromUnicode)
    For Each var In bytes
        sum = sum + var * GetNextMultiplier
    Next
    CheckDigit = sum Mod 10
End Function

Private Function GetNextMultiplier() As Integer
    Select Case m_multiplier
        Case 1
            m_multiplier = 7
        Case 7
            m_multiplier = 3
        Case 3
            m_multiplier = 1
    End Select
    GetNextMultiplier = m_multiplier
End Function
 

Niranjeen

Registered User.
Local time
Today, 10:33
Joined
Nov 16, 2007
Messages
24
Does this solve it?
Code:
Private m_multiplier As Integer

Private Sub TestCheckDigit()
    Debug.Print CheckDigit("NIRAN")
End Sub

Public Function CheckDigit(Text As String) As Integer
    Dim bytes() As Byte
    Dim var
    Dim sum As Long

    m_multiplier = 1
    bytes = StrConv(Text, vbFromUnicode)
    For Each var In bytes
        sum = sum + var * GetNextMultiplier
    Next
    CheckDigit = sum Mod 10
End Function

Private Function GetNextMultiplier() As Integer
    Select Case m_multiplier
        Case 1
            m_multiplier = 7
        Case 7
            m_multiplier = 3
        Case 3
            m_multiplier = 1
    End Select
    GetNextMultiplier = m_multiplier
End Function

Thank you, I have got it working, didn't think of two loops. Thank you again.
 

MarkK

bit cruncher
Local time
Today, 07:33
Joined
Mar 17, 2004
Messages
8,178
Mmm, there's only one loop! :)
But you're welcome, all the best!
 

Users who are viewing this thread

Top Bottom