VIN Check Digit

R

retro

New Member
Joined
Oct 21, 2010
Messages
3
I use the following formula in cell B1 to calculate a Vehicle Identification Number Check Digit:

=LOOKUP(MOD(SUMPRODUCT(LOOKUP(MID(A1,{1,2,3,4,5,6,7,8,10,11,12,13,14,15,16,17},1),{"0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F","G","H","J","K","L","M","N","P","R","S","T","U","V","W","X","Y","Z";0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,1,2,3,4,5,7,9,2,3,4,5,6,7,8,9}),{8,7,6,5,4,3,2,10,9,8,7,6,5,4,3,2}),11),{0,1,2,3,4,5,6,7,8,9,10;"0","1","2","3","4","5","6","7","8","9","X"})

In cell A1, I have the VIN.
In cell C1, I have use the formula:

=IF(MID(A1,9,1)=B1,"Y","N")

to determine if the check digit matches the VIN.

Is there a way, without using a macro, to reference the first formula for many VINs copied in column A without copying the formula to every cell in column B?
The formula is 392 characters long and the worksheet becomes very large when working with thousands of VINs.
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
You could use a referencing mechanism such as OFFSET
...LOOKUP(MID(OFFSET(A1,D1,0)... incrementing the value of D1 (as the row to evaluate) in leiu of the A1 reference you have, but you're introducing a lot of manual update/calc overhead with thousands of rows.
Even if you put a data validation on my D1 reference to provide a drop down - it's still a lot of clicks/calc.

could you not drag your formula down, do the tests, filter the results, copy/paste special values and then remove the formulas?
With the restriction of not populating cells, and no vba, you're rather handicapping viable solutions.
 
Upvote 0
I now wish to use VBA.

I try the following:

Function Vin(VinNum)
Vin = LOOKUP(MOD(SUMPRODUCT(LOOKUP(MID(VinNum,{1,2,3,4,5,6,7,8,10,11,12,13,14,15,16,17},1),{"0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F","G","H","J","K","L","M","N","P","R","S","T","U","V","W","X","Y","Z";0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,1,2,3,4,5,7,9,2,3,4,5,6,7,8,9}),{8,7,6,5,4,3,2,10,9,8,7,6,5,4,3,2}),11),{0,1,2,3,4,5,6,7,8,9,10;"0","1","2","3","4","5","6","7","8","9","X"})
End Function

and it does not allow the braces. What is the correct way to do this?
 
Upvote 0
Here's a version.
May need to add error checking at some point.
No Idea on large-scale performance
Goes in a Module

Researched SumProduct in VBA; real brain-tweaker; just built an array to run it.

Code: 
Option Base 1
Public Function fVinCheckv0(VinNum As Range)
'Use: fVinCheckv0(A1)
'Expects VinNum.Text to be 17 chars long
'Returns a CheckDigit
 
Dim Arr(16, 3)
CheckDigit = "X"
ArrIdx = 0
 
'Load 1st Array element with substitution values
For char = 1 To Len(VinNum.Text)
    If char <> 9 Then
        Select Case Mid(VinNum, char, 1)
            Case Is = "0"
                retval = 0
            Case Is = "1"
                retval = 1
            Case Is = "2"
                retval = 2
            Case Is = "3"
                retval = 3
            Case Is = "4"
                retval = 4
            Case Is = "5"
                retval = 5
            Case Is = "6"
                retval = 6
            Case Is = "7"
                retval = 7
            Case Is = "8"
                retval = 8
            Case Is = "9"
                retval = 9
            Case Is = "A"
                retval = 1
            Case Is = "B"
                retval = 2
            Case Is = "C"
                retval = 3
            Case Is = "D"
                retval = 4
            Case Is = "E"
                retval = 5
            Case Is = "F"
                retval = 6
            Case Is = "G"
                retval = 7
            Case Is = "H"
                retval = 8
            Case Is = "J"
                retval = 1
            Case Is = "K"
                retval = 2
            Case Is = "L"
                retval = 3
            Case Is = "M"
                retval = 4
            Case Is = "N"
                retval = 5
            Case Is = "P"
                retval = 7
            Case Is = "R"
                retval = 9
            Case Is = "S"
                retval = 2
            Case Is = "T"
                retval = 3
            Case Is = "U"
                retval = 4
            Case Is = "V"
                retval = 5
            Case Is = "W"
                retval = 6
            Case Is = "X"
                retval = 7
            Case Is = "Y"
                retval = 8
            Case Is = "Z"
                retval = 9
        End Select
 
        ArrIdx = ArrIdx + 1
        Arr(ArrIdx, 1) = retval
    End If
Next char
 
'Load the 2nd Array Element with second set of elements for SumProduct
Arr(1, 2) = 8
Arr(2, 2) = 7
Arr(3, 2) = 6
Arr(4, 2) = 5
Arr(5, 2) = 4
Arr(6, 2) = 3
Arr(7, 2) = 2
Arr(8, 2) = 10
Arr(9, 2) = 9
Arr(10, 2) = 8
Arr(11, 2) = 7
Arr(12, 2) = 6
Arr(13, 2) = 5
Arr(14, 2) = 4
Arr(15, 2) = 3
Arr(16, 2) = 2
 
'Calc the Products
For ArrIdx = 1 To UBound(Arr())
    Arr(ArrIdx, 3) = Arr(ArrIdx, 1) * Arr(ArrIdx, 2)
    Debug.Print "Product: "; Arr(ArrIdx, 3)
Next ArrIdx
 
'Compile the Sum [Resulting in SumProduct]
SPResult = 0
For ArrIdx = 1 To UBound(Arr())
    SPResult = SPResult + Arr(ArrIdx, 3)
Next ArrIdx
 
'Calc the Modulus
ModResult = SPResult Mod 11
 
'Perform Substitution on the Modulus Result
    Select Case ModResult
        Case Is = 0
            CheckDigit = "0"
        Case Is = 1
            CheckDigit = "1"
        Case Is = 2
            CheckDigit = "2"
        Case Is = 3
            CheckDigit = "3"
        Case Is = 4
            CheckDigit = "4"
        Case Is = 5
            CheckDigit = "5"
        Case Is = 6
            CheckDigit = "6"
        Case Is = 7
            CheckDigit = "7"
        Case Is = 8
            CheckDigit = "8"
        Case Is = 9
            CheckDigit = "9"
        Case Else
            CheckDigit = "X"
    End Select
 
'Return the answer
fVinCheckv0 = CheckDigit
 
End Function
 
Upvote 0
I really wanted to use the formula array approach, but since it appears they are not supported by VBA, I have the following approach which does what I need. Thanks for the replies.


Function sVinCd(sVinNum As String) As String
Dim Weights(1 To 17) As Integer
Weights(1) = 8
Weights(2) = 7
Weights(3) = 6
Weights(4) = 5
Weights(5) = 4
Weights(6) = 3
Weights(7) = 2
Weights(8) = 10
Weights(9) = 0
Weights(10) = 9
Weights(11) = 8
Weights(12) = 7
Weights(13) = 6
Weights(14) = 5
Weights(15) = 4
Weights(16) = 3
Weights(17) = 2

WeightSum = 0
For i = 1 To 17
Select Case Mid(sVinNum, i, 1)
Case "0"
Digit = 0
Case "1", "A", "J"
Digit = 1
Case "2", "B", "K", "S"
Digit = 2
Case "3", "C", "L", "T"
Digit = 3
Case "4", "D", "M", "U"
Digit = 4
Case "5", "E", "N", "V"
Digit = 5
Case "6", "F", "W"
Digit = 6
Case "7", "G", "P", "X"
Digit = 7
Case "8", "H", "Y"
Digit = 8
Case "9", "R", "Z"
Digit = 9
Case "I", "O", "Q"
sVinCd = "?"
Exit Function
Case Else
sVinCd = "?"
Exit Function
End Select
WeightSum = WeightSum + (Digit * Weights(i))
Next
intCheckDigit = WeightSum Mod 11
sCheckDigit = IIf(intCheckDigit = 10, "X", Trim(CStr(intCheckDigit)))
sVinCd = sCheckDigit
End Function
 
Upvote 0
tweedle said:
Here's a version.
May need to add error checking at some point.
No Idea on large-scale performance
Goes in a Module

Researched SumProduct in VBA; real brain-tweaker; just built an array to run it.

Code: 
Option Base 1
Public Function fVinCheckv0(VinNum As Range)
'Use: fVinCheckv0(A1)
'Expects VinNum.Text to be 17 chars long
'Returns a CheckDigit
 
Dim Arr(16, 3)
CheckDigit = "X"
ArrIdx = 0
 
'Load 1st Array element with substitution values
For char = 1 To Len(VinNum.Text)
    If char <> 9 Then
        Select Case Mid(VinNum, char, 1)
            Case Is = "0"
                retval = 0
            Case Is = "1"
                retval = 1
            Case Is = "2"
                retval = 2
            Case Is = "3"
                retval = 3
            Case Is = "4"
                retval = 4
            Case Is = "5"
                retval = 5
            Case Is = "6"
                retval = 6
            Case Is = "7"
                retval = 7
            Case Is = "8"
                retval = 8
            Case Is = "9"
                retval = 9
            Case Is = "A"
                retval = 1
            Case Is = "B"
                retval = 2
            Case Is = "C"
                retval = 3
            Case Is = "D"
                retval = 4
            Case Is = "E"
                retval = 5
            Case Is = "F"
                retval = 6
            Case Is = "G"
                retval = 7
            Case Is = "H"
                retval = 8
            Case Is = "J"
                retval = 1
            Case Is = "K"
                retval = 2
            Case Is = "L"
                retval = 3
            Case Is = "M"
                retval = 4
            Case Is = "N"
                retval = 5
            Case Is = "P"
                retval = 7
            Case Is = "R"
                retval = 9
            Case Is = "S"
                retval = 2
            Case Is = "T"
                retval = 3
            Case Is = "U"
                retval = 4
            Case Is = "V"
                retval = 5
            Case Is = "W"
                retval = 6
            Case Is = "X"
                retval = 7
            Case Is = "Y"
                retval = 8
            Case Is = "Z"
                retval = 9
        End Select
 
        ArrIdx = ArrIdx + 1
        Arr(ArrIdx, 1) = retval
    End If
Next char
 
'Load the 2nd Array Element with second set of elements for SumProduct
Arr(1, 2) = 8
Arr(2, 2) = 7
Arr(3, 2) = 6
Arr(4, 2) = 5
Arr(5, 2) = 4
Arr(6, 2) = 3
Arr(7, 2) = 2
Arr(8, 2) = 10
Arr(9, 2) = 9
Arr(10, 2) = 8
Arr(11, 2) = 7
Arr(12, 2) = 6
Arr(13, 2) = 5
Arr(14, 2) = 4
Arr(15, 2) = 3
Arr(16, 2) = 2
 
'Calc the Products
For ArrIdx = 1 To UBound(Arr())
    Arr(ArrIdx, 3) = Arr(ArrIdx, 1) * Arr(ArrIdx, 2)
    Debug.Print "Product: "; Arr(ArrIdx, 3)
Next ArrIdx
 
'Compile the Sum [Resulting in SumProduct]
SPResult = 0
For ArrIdx = 1 To UBound(Arr())
    SPResult = SPResult + Arr(ArrIdx, 3)
Next ArrIdx
 
'Calc the Modulus
ModResult = SPResult Mod 11
 
'Perform Substitution on the Modulus Result
    Select Case ModResult
        Case Is = 0
            CheckDigit = "0"
        Case Is = 1
            CheckDigit = "1"
        Case Is = 2
            CheckDigit = "2"
        Case Is = 3
            CheckDigit = "3"
        Case Is = 4
            CheckDigit = "4"
        Case Is = 5
            CheckDigit = "5"
        Case Is = 6
            CheckDigit = "6"
        Case Is = 7
            CheckDigit = "7"
        Case Is = 8
            CheckDigit = "8"
        Case Is = 9
            CheckDigit = "9"
        Case Else
            CheckDigit = "X"
    End Select
 
'Return the answer
fVinCheckv0 = CheckDigit
 
End Function
Click to expand...

Just wanted to say, that I am using this to go through about 11,000 possible VINs to find 8 that I am missing to complete a registry for a rare model of Chevrolet Colorado. Thank you!

I will be using it to go through GMC VINs that I dont already have in the registry as well.

I have it set up combine the 8 digit prefix and the check digit and the 8 digit suffix for each VIN in a sequence of VINs. The I put the into Compnine to see if they come back with build data.

This is all to calculate rarity and sequence the trucks based on build date. It's been a year in the making and this was the last piece of the puzzle to fine the last 8 VINs that I don't have to match up with their respective build data.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Excel formula help!!!
Replies
4
Views
302
felixstraube
F
A
  • Question
Comparing and Combining Two Worksheets
Replies
1
Views
268
OaklandJim
O
A
  • Question
Need a formula to calculate a MOD10 check digit for a string of 26 numbers.
Replies
2
Views
580
Georgiboy
Georgiboy
H
  • Solved
Extract 8 digit number from a string
2
Replies
14
Views
2K
Hans K
H
S
  • Question
VBA to ignore certain MAC Address values but process all others
Replies
1
Views
231
myall_blues
myall_blues

Forum statistics

Threads
1,215,475
Messages
6,125,028
Members
449,205
Latest member
Eggy66

Share this page

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
Back
Top