Verhoeffs Dihedral Check

[Oorang]

Does anyone know of a VBA implementation of this?

 

[ChrisUK]

Well, I didn't even know what it was!

So, I googled it and got this website (amongst others)

http://www.augustana.ca/~mohrj/algorithms/checkdigit.html#verhoeff

To be honest I'm still no wiser, I always hated maths! But, this site has a form which does this check for you and if you view the source it's all there .... but in JavaScript

So, I suppose I should get half marks for getting part way there ... anyone want to do the next bit and turn the JavaScript into VB code ?

Chris

 

[Greg Truby]

Aaron - Like Chris, I'd never heard of it. Given what I know of you, I am going to assume that you've already googled the term and seen some Java implementations. Unfortunately I don't know enough Java to be able to offer a "translation". But perhaps another boardmember can do something with:

http://www.cs.utsa.edu/~wagner/laws/verhoeff.html

or

http://www.cs.utsa.edu/~wagner/laws/AVerhoeffErrorDetection.html

 

[Greg Truby]

I didn't try it, but check out page 35 of this PDF...

http://ww2.it.nuigalway.ie/rfleming...ED/Snomed documentation/SNOMEDCT_Core_v23.pdf

 

[ChrisUK]

Nice one!

Now all someone has to do is figure out what to call when ...

We're getting there slowly ....

Chris

 

[Oorang]

Very nice. I wanted to get rid of the variants and add error handlers so I made the following changes. I still haven't wrapped my head around the math so I am not totally confident that it tests right. When given the same set of inputs both programs generate the same output, but just as a double check, if someone gets the math, could they validate this?
(I liked Luhn10, it was simple and I could do it by hand. But NOOOOO )
<hr>
<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN>
<SPAN style="color:#00007F">Private</SPAN> bytDhdrl(9, 9) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>
<SPAN style="color:#00007F">Private</SPAN> bytFnF(7, 9) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>
<SPAN style="color:#00007F">Private</SPAN> bytInvrseD5(9) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Const</SPAN> strErr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "Error: "
<SPAN style="color:#00007F">Function</SPAN> VerhoeffValidate(<SPAN style="color:#00007F">ByVal</SPAN> IdValue <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>
    <SPAN style="color:#007F00">'Check the supplied value and return true or false</SPAN>
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> Err_Hnd
    <SPAN style="color:#00007F">Dim</SPAN> intTChk <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> intLC <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
    ArrayInit
    <SPAN style="color:#00007F">For</SPAN> intLC = VBA.Len(IdValue) <SPAN style="color:#00007F">To</SPAN> 1 <SPAN style="color:#00007F">Step</SPAN> -1
        intTChk = bytDhdrl(intTChk, bytFnF((VBA.Len(IdValue) - intLC) Mod 8, Val(VBA.Mid$(IdValue, intLC, 1))))
    <SPAN style="color:#00007F">Next</SPAN>
    VerhoeffValidate = intTChk = 0
    <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN>
Err_Hnd:
    MsgBox Err.Description, vbCritical, strErr & Err.Number
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
<SPAN style="color:#00007F">Function</SPAN> VerhoeffGenCheck(<SPAN style="color:#00007F">ByVal</SPAN> IdValue <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> Err_Hnd
    <SPAN style="color:#00007F">Dim</SPAN> intTChk <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> intLC <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
    <SPAN style="color:#007F00">'Compute the check digit and return the identifier complete with check-digit</SPAN>
    ArrayInit
    <SPAN style="color:#00007F">For</SPAN> intLC = VBA.Len(IdValue) <SPAN style="color:#00007F">To</SPAN> 1 <SPAN style="color:#00007F">Step</SPAN> -1
        intTChk = bytDhdrl(intTChk, bytFnF((VBA.Len(IdValue) - intLC + 1) Mod 8, VBA.Val(VBA.Mid$(IdValue, intLC, 1))))
    <SPAN style="color:#00007F">Next</SPAN>
    VerhoeffGenCheck = bytInvrseD5(intTChk)
    <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN>
Err_Hnd:
    MsgBox Err.Description, vbCritical, strErr & Err.Number
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> ArrayInit()
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> Err_Hnd
    <SPAN style="color:#007F00">'Create the arrays required</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> bytI <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> bytJ <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>
    <SPAN style="color:#007F00">'if already created exit here</SPAN>
    <SPAN style="color:#00007F">If</SPAN> bytInvrseD5(1) = 4 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
    <SPAN style="color:#007F00">'create the bytDhdrlD5 array</SPAN>
    bytDhdrl(0, 0) = 0: bytDhdrl(0, 1) = 1: bytDhdrl(0, 2) = 2: bytDhdrl(0, 3) = 3: bytDhdrl(0, 4) = 4: bytDhdrl(0, 5) = 5: bytDhdrl(0, 6) = 6: bytDhdrl(0, 7) = 7: bytDhdrl(0, 8) = 8: bytDhdrl(0, 9) = 9
    bytDhdrl(1, 0) = 1: bytDhdrl(1, 1) = 2: bytDhdrl(1, 2) = 3: bytDhdrl(1, 3) = 4: bytDhdrl(1, 4) = 0: bytDhdrl(1, 5) = 6: bytDhdrl(1, 6) = 7: bytDhdrl(1, 7) = 8: bytDhdrl(1, 8) = 9: bytDhdrl(1, 9) = 5
    bytDhdrl(2, 0) = 2: bytDhdrl(2, 1) = 3: bytDhdrl(2, 2) = 4: bytDhdrl(2, 3) = 0: bytDhdrl(2, 4) = 1: bytDhdrl(2, 5) = 7: bytDhdrl(2, 6) = 8: bytDhdrl(2, 7) = 9: bytDhdrl(2, 8) = 5: bytDhdrl(2, 9) = 6
    bytDhdrl(3, 0) = 3: bytDhdrl(3, 1) = 4: bytDhdrl(3, 2) = 0: bytDhdrl(3, 3) = 1: bytDhdrl(3, 4) = 2: bytDhdrl(3, 5) = 8: bytDhdrl(3, 6) = 9: bytDhdrl(3, 7) = 5: bytDhdrl(3, 8) = 6: bytDhdrl(3, 9) = 7
    bytDhdrl(4, 0) = 4: bytDhdrl(4, 1) = 0: bytDhdrl(4, 2) = 1: bytDhdrl(4, 3) = 2: bytDhdrl(4, 4) = 3: bytDhdrl(4, 5) = 9: bytDhdrl(4, 6) = 5: bytDhdrl(4, 7) = 6: bytDhdrl(4, 8) = 7: bytDhdrl(4, 9) = 8
    bytDhdrl(5, 0) = 5: bytDhdrl(5, 1) = 9: bytDhdrl(5, 2) = 8: bytDhdrl(5, 3) = 7: bytDhdrl(5, 4) = 6: bytDhdrl(5, 5) = 0: bytDhdrl(5, 6) = 4: bytDhdrl(5, 7) = 3: bytDhdrl(5, 8) = 2: bytDhdrl(5, 9) = 1
    bytDhdrl(6, 0) = 6: bytDhdrl(6, 1) = 5: bytDhdrl(6, 2) = 9: bytDhdrl(6, 3) = 8: bytDhdrl(6, 4) = 7: bytDhdrl(6, 5) = 1: bytDhdrl(6, 6) = 0: bytDhdrl(6, 7) = 4: bytDhdrl(6, 8) = 3: bytDhdrl(6, 9) = 2
    bytDhdrl(7, 0) = 7: bytDhdrl(7, 1) = 6: bytDhdrl(7, 2) = 5: bytDhdrl(7, 3) = 9: bytDhdrl(7, 4) = 8: bytDhdrl(7, 5) = 2: bytDhdrl(7, 6) = 1: bytDhdrl(7, 7) = 0: bytDhdrl(7, 8) = 4: bytDhdrl(7, 9) = 3
    bytDhdrl(8, 0) = 8: bytDhdrl(8, 1) = 7: bytDhdrl(8, 2) = 6: bytDhdrl(8, 3) = 5: bytDhdrl(8, 4) = 9: bytDhdrl(8, 5) = 3: bytDhdrl(8, 6) = 2: bytDhdrl(8, 7) = 1: bytDhdrl(8, 8) = 0: bytDhdrl(8, 9) = 4
    bytDhdrl(9, 0) = 9: bytDhdrl(9, 1) = 8: bytDhdrl(9, 2) = 7: bytDhdrl(9, 3) = 6: bytDhdrl(9, 4) = 5: bytDhdrl(9, 5) = 4: bytDhdrl(9, 6) = 3: bytDhdrl(9, 7) = 2: bytDhdrl(9, 8) = 1: bytDhdrl(9, 9) = 0
    <SPAN style="color:#007F00">'create the FunctionF array</SPAN>
    bytFnF(0, 0) = 0: bytFnF(0, 1) = 1: bytFnF(0, 2) = 2: bytFnF(0, 3) = 3: bytFnF(0, 4) = 4: bytFnF(0, 5) = 5: bytFnF(0, 6) = 6: bytFnF(0, 7) = 7: bytFnF(0, 8) = 8: bytFnF(0, 9) = 9
    bytFnF(1, 0) = 1: bytFnF(1, 1) = 5: bytFnF(1, 2) = 7: bytFnF(1, 3) = 6: bytFnF(1, 4) = 2: bytFnF(1, 5) = 8: bytFnF(1, 6) = 3: bytFnF(1, 7) = 0: bytFnF(1, 8) = 9: bytFnF(1, 9) = 4
    <SPAN style="color:#007F00">'compute the rest of the FunctionF array</SPAN>
    <SPAN style="color:#00007F">For</SPAN> bytI = 2 <SPAN style="color:#00007F">To</SPAN> 7
        <SPAN style="color:#00007F">For</SPAN> bytJ = 0 <SPAN style="color:#00007F">To</SPAN> 9
            bytFnF(bytI, bytJ) = bytFnF(bytI - 1, bytFnF(1, bytJ))
        <SPAN style="color:#00007F">Next</SPAN> bytJ
    <SPAN style="color:#00007F">Next</SPAN> bytI
    <SPAN style="color:#007F00">'Create the bytInvrseD5 array</SPAN>
    bytInvrseD5(0) = 0: bytInvrseD5(1) = 4: bytInvrseD5(2) = 3: bytInvrseD5(3) = 2: bytInvrseD5(4) = 1: bytInvrseD5(5) = 5: bytInvrseD5(6) = 6: bytInvrseD5(7) = 7: bytInvrseD5(8) = 8: bytInvrseD5(9) = 9
    <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
Err_Hnd:
    MsgBox Err.Description, vbCritical, strErr & Err.Number
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[Trinetra27]

Hello!
I'm going to reply to a 14 year old post with a big THANK YOU. Verhoeff's Dihedral check is used as the algorithm for validating India's Aadhaar unique identification numbers. I'm pleased to tell you (a little late, I know!) that I've run your algorithm over several aadhaar numbers and it works perfectly. So, for folks from India searching the interwebs for 'Excel macro for aadhaar check', the post above works perfectly.

 

[fiazidris]

Here is the Macro Excel File with above code.. sample numbers, check digits, combind sample+checkdigit, transposition check.
Verified Indian Aadhaar.. it works.
Verified few other number.. it works too.

Download from GDrive here (Verhoeff_CheckDigit.xlsm)