Looking for VBA to compute a MOD10 Check Digit on an alphanumeric string

mikestorm

New Member
Joined
Feb 3, 2021
Messages
9
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi everyone, I'm looking for a little help to create VBA code that computes a check digit for a column of alpha numeric strings (a lockbox scanline for a mailing) in an excel spreadsheet. I created a calculator in excel to compute check digits given variable assumptions, but it only works one scanline at a time and I need something that's scalable to create many check digits for an array of scanlines (VBA). I found a few pieces of code and formulas for numerical only scanlines, but nothing that can handle alphanumeric. Others have posted similar requests but they get a bit wishy washy on documenting the logic making it hard for people to help, so I'm hopeful that's where I differ.

Here are the specs:
Mod10
137 weight
Scanline length: would love the VBA to be able to handle variable lengths.

Alpha substation table
Alpha Substitutions
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
1​
T
2​
U
3​
V
4​
W
5​
X
6​
Y
7​
Z
8​

Here's the logic:

Example Scanline (without the check digit):
013100280UAG210021UAMR000021AL0002000

Scanline minus check digit:
013100280UAG210021UAMR000021AL0002000
Numerically converted (from alpha substitutions above):
0​
1​
3​
1​
0​
0​
2​
8​
0​
3​
1​
7​
2​
1​
0​
0​
2​
1​
3​
1​
4​
9​
0​
0​
0​
0​
2​
1​
1​
3​
0​
0​
0​
2​
0​
0​
0​
Weights (from spec):
1​
3​
7​
1​
3​
7​
1​
3​
7​
1​
3​
7​
1​
3​
7​
1​
3​
7​
1​
3​
7​
1​
3​
7​
1​
3​
7​
1​
3​
7​
1​
3​
7​
1​
3​
7​
1​
Weighted Value (place multiplied by weight):
0​
3​
21​
1​
0​
0​
2​
24​
0​
3​
3​
49​
2​
3​
0​
0​
6​
7​
3​
3​
28​
9​
0​
0​
0​
0​
14​
1​
3​
21​
0​
0​
0​
2​
0​
0​
0​

Sum of Weighted Values: 0+3+21+1+0+0+2+24 etc = 208
Expected Check Digit (ones position of preceding sum): 8
Scanline with check digit: 013100280UAG210021UAMR000021AL00020008

The VBA need only print the check digit (in this case 8) in the cell to the right of the scanline, and the column to the right of that will be a concatenation of the scanline + check digit and that's what sent to the printer.

The coding is decidedly out of my depth, but I can answer any questions about the spec or the logic. Any help would be appreciated.
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,400
Office Version
  1. 365
Platform
  1. Windows
A function like this could produce your 208. Is the 8 just the last digit of that?

VBA Code:
Function CheckSum(Input_Value As String, Input_Weight As String) As Long

Dim a As Long, lSum As Long

a = 0
For i = 1 To Len(Input_Value)
    If a = Len(Input_Weight) Then
        a = 1
    Else
        a = a + 1
    End If
    If IsNumeric(Mid(Input_Value, i, 1)) Then
        lSum = lSum + Mid(Input_Value, i, 1) * Mid(Input_Weight, a, 1)
    Else
        conv = IIf((Asc(Mid(Input_Value, i, 1)) - 64) Mod 9 = 0, 9, (Asc(Mid(Input_Value, i, 1)) - 64) Mod 9)
        lSum = lSum + conv * Mid(Input_Weight, a, 1)
    End If
Next

CheckSum = lSum

End Function
 
Solution

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,302
Office Version
  1. 2010
Platform
  1. Windows
yeh the checksum will be lSum Mod 10 steve
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,400
Office Version
  1. 365
Platform
  1. Windows
Cheers Diddi. So just change the last line to what Diddi said and you will be good to go.
 

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,302
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

VBA Code:
....
Next i

CheckSum = lSum Mod 10

End Function
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,980
Office Version
  1. 2016
Platform
  1. Windows
Here is another way to write the CheckSum function...
VBA Code:
Function CheckSum(ByVal Scanline As String, ByVal Weights As String) As Variant
  Dim X As Long, ArrSL As Variant, ArrWgts As Variant
  ArrWgts = Evaluate("{" & Replace(Replace(Weights, " ", ""), ",", ";") & "}")
  ArrSL = Split(Trim(Replace(StrConv(Scanline, vbUnicode), Chr(0), " ")))
  For X = 1 To UBound(ArrSL)
    If ArrSL(X) Like "[A-Z]" Then ArrSL(X) = 1 + (Asc(ArrSL(X)) - 65) Mod 9
  Next
  ArrSL = Evaluate("{" & Join(ArrSL, ",") & "}")
  CheckSum = Application.MMult(ArrSL, ArrWgts)(1) Mod 10
End Function
 

mikestorm

New Member
Joined
Feb 3, 2021
Messages
9
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

This is amazing. I tried Steve's solution with Diddi's input and it worked like a charm. I also tried Rick's solution but I couldn't get it to work (#VALUE).
 

mikestorm

New Member
Joined
Feb 3, 2021
Messages
9
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Just wanted to say I modified the above solution a bit, so you can now input the MOD and you have the option of returning the Base Minus Remainder if you like. Scanline Check Digits are mostly MOD10 but there are some MOD11 variants out there, and some algorithms take the base minus the remainder (instead of the remainder of the base).

VBA Code:
Function CheckSum(Scanline As String, Modulo As Integer, Weights As String, Base_Minus_Remainder As Integer) As Long

Dim a As Long, lSum As Long

a = 0
For i = 1 To Len(Scanline)
    If a = Len(Weights) Then
        a = 1
    Else
        a = a + 1
    End If
    If IsNumeric(Mid(Scanline, i, 1)) Then
        lSum = lSum + Mid(Scanline, i, 1) * Mid(Weights, a, 1)
    Else
        conv = IIf((Asc(Mid(Scanline, i, 1)) - 64) Mod 9 = 0, 9, (Asc(Mid(Scanline, i, 1)) - 64) Mod 9)
        lSum = lSum + conv * Mid(Weights, a, 1)
    End If
Next i

If Base_Minus_Remainder = 0 Then
CheckSum = Right(lSum Mod Modulo,1)
Else
CheckSum = Right(10 - (lSum Mod Modulo),1)
End If
End Function
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,980
Office Version
  1. 2016
Platform
  1. Windows
For my code, how did you pass in the scan line and weights?
 

Watch MrExcel Video

Forum statistics

Threads
1,130,051
Messages
5,639,773
Members
417,112
Latest member
PachRedoc

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top