Algorithm (1 Viewer)

[Klegg72]

Hello,
I need to use an algorithm to derive a driver's license for each lead as each record is created.

The fields in my table used in the algorithm
FullName (LLLLL L LLLLLLLL) aka (FFFFF M LLLLLL)
DOB (99/99/9999)

Here's the algorithm

LLLLLFMYYXmb

LLLLL - Last Name, truncated - The first five characters are the first five letters of the last name. If the name is shorter than five characters, the extra space is padded with asterisks (*).

F - First Initial

M - Middle Initial

YY - Year of birth, encoded - This is 100 minus the the two digit year of birth. So someone born in 1998 will be 2 (100-98), as will someone born in 1898. If the birth year is a 1900 or 2000 the result is 00, not 100.

X - Checksum - This cannot be calculated until you know the rest of the license.

Once you have all of the rest of the license characters the following equation will determine the checksum. a1 is the first character (the first letter of the last name), a2 is the second letter, and so on.

checksum = (a1 - a2 + a3 - a4 + a5 - a6 + a7 - a8 + a9 - a11 + a12) mod 10;

For non digits, you can find the number to use in the equation here:

* 4
A 1
B 2
C 3
D 4
E 5
F 6
G 7
H 8
I 9
J 1
K 2
L 3
M 4
N 5
O 6
P 7
Q 8
R 9
S 2
T 3
U 4
V 5
W 6
X 7
Y 8
Z 9
m - Month of birth, encoded. Look up your birth month on this table.

Jan 1 B
Feb 2 C
Mar 3 D
Apr 4 J
May 5 K
Jun 6 L
Jul 7 M
Aug 8 N
Sep 9 O
Oct 10 P
Nov 11 Q
Dec 12 R
d - Day of month of birth, encoded - Look up the code for your birth's day of month.

1 A
2 B
3 C
4 D
5 E
6 F
7 G
8 H
9 Z
10 S
11 J
12 K
13 L
14 M
15 N
16 W
17 P
18 Q
19 R
20 0
21 1
22 2
23 3
24 4
25 5
26 2
27 7
28 8
29 9
30 T
31 U

Thanks in Advance for any help.

I've tried to do this myself with no luck, and I know that mentioning my progress will lead to biased results; I would like to hear the best way to get it done not a redirection of the methods I've tried.

 

[JANR]

This should be straight forward by using various string-functions and a few Date() functions.

First you need to create a Main custom function that accepts 2 parameters namely the fullname and DOB, and also Dim a few holding variables.

Function GetLicence(AnyString As String, DOB As Date) As String
Dim tmpString As string
... etc
...code
End Function

To get the first 5 letters from the last name you can use the Mid() function:

tmpStr = Mid(AnyString, InStrRev(AnyString, " ") + 1, 5)

and to add "*" as padding you can try a loop:

For y = Len(tmpStr) To 4
   tmpStr = tmpStr & "*"
Next

First Initial should be easy with the Left() function

F = Left(AnyString, 1)

Now middle initial can be problematic, what if the person do not have it, how do intent to handle that?? Do you replace that empty space with something else like "*" or is it blank.

ex: John * Smith

If you use "*" then use the Mid()function again:

MM = Mid(AnyString, InStr(AnyString, " ") + 1, 1)

For the year you test DOB againt the Year() function and test the value with an IF-Then statement

YY = 100 - CInt(Right(Year(DOB), 2))
If YY = 100 Then
        YY = "00"
    Else
        YY = Format(YY, "00")
    End If

Day and month would be easiest to do a Dlookup against a table with the Day() and Month() function against your DOB parameter.

m = DLookup("Letter", "tblMonth", "ID =" & Month(DOB))
d = DLookup("Letter", "tblDays", "ID =" & Day(DOB))

You have all the elements you need to calculate your checksum, just pass your assabled string to a function to do the calculation and get back the checksum to put in place in your finished string.

The easiest would be to step through the string one character at the time and lookup the number in a table, and since everyother char is either positive or negative you could use Stepping to sum all the positive and all the negatives to make life easier.

Function CheckSum(AnyString As String) As Integer
'checksum = (a1 - a2 + a3 - a4 + a5 - a6 + a7 - A8 + a9 - a11 + a12) mod 10
'             s    m    i    t    h    j    j    1    5     d     d
Dim Pos As Integer
Dim Neg As Integer
Dim x As Integer

    For x = 1 To Len(AnyString) Step 2
        If Not IsNumeric(Mid(AnyString, x, 1)) Then
            Pos = Pos + DLookup("CodeNum", "tblCodes", "Letter='" & Mid(AnyString, x, 1) & "'")
        Else
            Pos = Pos + Mid(AnyString, x, 1)
        End If
    Next
            
    For x = 2 To Len(AnyString) Step 2
        If Not IsNumeric(Mid(AnyString, x, 1)) Then
            Neg = Neg + DLookup("CodeNum", "tblCodes", "Letter='" & Mid(AnyString, x, 1) & "'")
        Else
            Neg = Neg + Mid(AnyString, x, 1)
        End If
    Next

CheckSum = (Pos - Neg) Mod 10

End Function

See if this gets you closer to your goal.

Edit:
FYI this will fall flat on your face IF you have names like James J Müller or some other funky names.

JR

 

[Slides]

Interesting

 

[Klegg72]

Awesome! I am excited to implement that

Thank You