Calculate chekdigit Mod10 Luhn Algorithm

[Leika]

I need help on creating a way to automatic calculate a chekdigit to my
Customer number
It is needed on my “Giro cartâ€
It has to be modulus 10 (Mod10, Luhn Algorithm).
Hope you understand what it is I need.
And I’ll really appreciate any help I can get.

 

[Marshall Barton]

I need help on creating a way to automatic calculate a chekdigit to my
Customer number
It is needed on my “Giro cart”
It has to be modulus 10 (Mod10, Luhn Algorithm).
Hope you understand what it is I need.

I don't know that method, but I suspect it's something like
this:

Check = 0
For K = 1 to Len(CustNum)
Check = (Check + CInt(Mid(CustNum, K, 1))) Mod 10
Next

 

[Leika]

I'm afred its a litle more complicadet
Betalingsident.: 0 2 6 8 4 0 1 4 9 9 6 5 3 2
Vægttal: 1 2 1 2 1 2 1 2 1 2 1 2 1 2
Summer: 0 4 6 16 4 0 1 8 9 18 6 10 3 4
Tæller: 0 +4 +6 +7 +4 +0 +1 +8 +9 +9 +6 +1 +3 +4=62
Tæller/modulus 62/10 = rest = 2
Kontrolciffer 10 - 2 = 8
It looks like this but how do i get it to make me a chekdigit

"Marshall Barton" skrev:

 

[Brendan Reynolds]

The following is a quick-and-dirty solution that would probably benefit from
optimization - reducing the number of loops through the array might pay
dividends. But it seems to work ...

Public Function CalcCheckDigit(ByVal strInput As String) As String

'Betalingsident.: 0 2 6 8 4 0 1 4 9 9 6 5 3 2
'Vægttal: 1 2 1 2 1 2 1 2 1 2 1 2 1 2
'Summer: 0 4 6 16 4 0 1 8 9 18 6 10 3 4
'Tæller: 0 +4 +6 +7 +4 +0 +1 +8 +9 +9 +6 +1 +3 +4=62
'Tæller/modulus 62/10 = rest = 2
'Kontrolciffer 10 - 2 = 8

Dim alngWork() As Long
Dim lngLoop As Long
Dim lngMultiplier As Long
Dim lngResult As Long

ReDim alngWork(0 To Len(strInput) - 1)

For lngLoop = 1 To Len(strInput)
alngWork(lngLoop - 1) = CLng(Mid$(strInput, lngLoop, 1))
Next lngLoop
For lngLoop = LBound(alngWork) To UBound(alngWork)
If (lngLoop + 1) Mod 2 Then
lngMultiplier = 1
Else
lngMultiplier = 2
End If
alngWork(lngLoop) = alngWork(lngLoop) * lngMultiplier
Next lngLoop
For lngLoop = LBound(alngWork) To UBound(alngWork)
lngResult = lngResult + ((alngWork(lngLoop) \ 10) +
(alngWork(lngLoop) Mod 10))
Next lngLoop
lngResult = 10 - (lngResult Mod 10)

CalcCheckDigit = lngResult

End Function

 

[Leika]

Dear Brendan Reynolds
It looks so good, but:
I don’t know what I'm doing wrong but I keep getting this:
Run-time error'13':
Type mismatch
In this line:
alngWork(lngLoop - 1) = CLng(Mid$(strInput, lngLoop, 1))

Coulden't you pleas send me you’r working “eksampel.mdbâ€
Directly by mail: fox66400â€@â€hotmail.com … just get rid of the “ “
That would just be great.

 

[Brendan Reynolds]

The most likely cause of this is that the data you are passing in the
strInput argument includes one or more non-numeric characters. For example,
if your customer number looked something like "ABC123", you'd need to strip
off the "ABC" portion and pass only the "123" part to the function.
Similarly if your customer number includes any spaces, punctuation or such,
you'll need to strip them out first. If you want the function to handle that
for you, you could modify it something like so ...

Public Function CalcCheckDigit(ByVal strInput As String) As String

'Betalingsident.: 0 2 6 8 4 0 1 4 9 9 6 5 3 2
'Vægttal: 1 2 1 2 1 2 1 2 1 2 1 2 1 2
'Summer: 0 4 6 16 4 0 1 8 9 18 6 10 3 4
'Tæller: 0 +4 +6 +7 +4 +0 +1 +8 +9 +9 +6 +1 +3 +4=62
'Tæller/modulus 62/10 = rest = 2
'Kontrolciffer 10 - 2 = 8

Dim strWork As String
Dim strChar As String
Dim alngWork() As Long
Dim lngLoop As Long
Dim lngMultiplier As Long
Dim lngResult As Long

For lngLoop = 1 To Len(strInput)
strChar = Mid$(strInput, lngLoop, 1)
If Asc(strChar) >= Asc("0") And Asc(strChar) <= Asc("9") Then
strWork = strWork & strChar
End If
Next lngLoop

ReDim alngWork(0 To Len(strWork) - 1)

For lngLoop = 1 To Len(strWork)
alngWork(lngLoop - 1) = CLng(Mid$(strWork, lngLoop, 1))
Next lngLoop
For lngLoop = LBound(alngWork) To UBound(alngWork)
If (lngLoop + 1) Mod 2 Then
lngMultiplier = 1
Else
lngMultiplier = 2
End If
alngWork(lngLoop) = alngWork(lngLoop) * lngMultiplier
Next lngLoop
For lngLoop = LBound(alngWork) To UBound(alngWork)
lngResult = lngResult + ((alngWork(lngLoop) \ 10) +
(alngWork(lngLoop) Mod 10))
Next lngLoop
lngResult = 10 - (lngResult Mod 10)

CalcCheckDigit = lngResult

End Function

 

[Leika]

Thanks
It wasent your code it wase me.
I found My error and fixed it.
1000000 thanks

 

[Matt Lockamy]

I tried using this code, but it keeps returning incorrect results. For
example, 4467825 returns the result 10. ??? Please help, I am very new to
all of this (and a little out of my league).

 

[Brendan Reynolds]

It's been some time, and the algorithm was supplied by the original poster -
I just wrote code to implement the algorithm as supplied. But I think the
length of the input string is significant. If I pad out your example with
leading zeros to be 14 characters long (as in the original example) I get
the result 8. Is that the result you'd expect from that input?

? calccheckdigit("00000004467825")
8

 

[Matt Lockamy]

Yes, 8 is the expected result. How do I alter the code to make it work for 7
digit numbers? Thanks again!

 

[Brendan Reynolds]

As I said, the algorithm was supplied by the original poster. I just wrote
code to implement the algorithm as posted. So I'm not 100% certain of this,
but I think an even number of digits is required. The following modification
may work for you, but you'll need to test it carefully before putting any
trust in it. The modification is the three lines following the "New code"
comment.

Public Function CalcCheckDigit(ByVal strInput As String) As String

'Betalingsident.: 0 2 6 8 4 0 1 4 9 9 6 5 3 2
'Vægttal: 1 2 1 2 1 2 1 2 1 2 1 2 1 2
'Summer: 0 4 6 16 4 0 1 8 9 18 6 10 3 4
'Tæller: 0 +4 +6 +7 +4 +0 +1 +8 +9 +9 +6 +1 +3 +4=62
'Tæller/modulus 62/10 = rest = 2
'Kontrolciffer 10 - 2 = 8

Dim strWork As String
Dim strChar As String
Dim alngWork() As Long
Dim lngLoop As Long
Dim lngMultiplier As Long
Dim lngResult As Long

For lngLoop = 1 To Len(strInput)
strChar = Mid$(strInput, lngLoop, 1)
If Asc(strChar) >= Asc("0") And Asc(strChar) <= Asc("9") Then
strWork = strWork & strChar
End If
Next lngLoop

'New code.
If Len(strWork) Mod 2 <> 0 Then
strWork = "0" & strWork
End If

ReDim alngWork(0 To Len(strWork) - 1)

For lngLoop = 1 To Len(strWork)
alngWork(lngLoop - 1) = CLng(Mid$(strWork, lngLoop, 1))
Next lngLoop
For lngLoop = LBound(alngWork) To UBound(alngWork)
If (lngLoop + 1) Mod 2 Then
lngMultiplier = 1
Else
lngMultiplier = 2
End If
alngWork(lngLoop) = alngWork(lngLoop) * lngMultiplier
Next lngLoop
For lngLoop = LBound(alngWork) To UBound(alngWork)
lngResult = lngResult + ((alngWork(lngLoop) \ 10) +
(alngWork(lngLoop) Mod 10))
Next lngLoop
lngResult = 10 - (lngResult Mod 10)

CalcCheckDigit = lngResult

End Function