Something to keep you busy on those miserable, wet Sundays. Whether it works for all cards is another matter it certainly worked on my Mastercard
Credit cards do have an algorithm, I thought it was a combination of the expiry date and number but it turns out it is far less complex than that.
Your credit card consists of 16 digits.
The first digit indicates the type of industry issuing the card. ie 4 or 5 = Banking
This is very closely guarded information so I had to glean it from a very secret source:
The next 5 digits identify the card issuer ie your bank
The remaining digits excluding the last are your account number or identifier.
The last digit is a checksum.
How does that work I hear you ask?
Remove the last digit
Multiply each alternate digit in the number by 2 starting from the right (after removing the last digit).
The last six digits of my card are 516348 so they would be:
5
1
6
3
4
8
5
2
6
6
4
16
If the number is greater than 10 add the two digits together, so:
5
1
6
3
4
8
5
2
6
6
4
16
5
2
6
6
4
7
Then add all the digits together (remembering this is for all 15 digits not just the six in my example).
Say you get 105.
Subtract the last digit (in this case 5) from 10 (unless it is zero then don’t do anything) the resultant digit should be the checksum ie the last digit in your credit card number.
It worked for my card, the last digit was a 3, after going through the procedure above the total was 37, 10-7 = 3
Option Explicit
Sub CheckCardNumber()
Dim strNum As String
Dim strTwo As String
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim arrNumbers(1 To 16) As Variant
Sheets(1).Activate
'concacinate numbers in highlighted cells'
strNum = Cells(1, 1).Value & Cells(1, 2).Value & Cells(1, 3).Value & Cells(1, 4).Value
'Multiply alternate numbers from position 15 by 2 and check they are less than ten'
For X = 15 To 1 Step -2
Y = 0
strTwo = (Mid(strNum, X, 1) * 2)
If Len(strTwo) > 1 Then
For Z = 1 To 2
Y = Y + Mid(strTwo, Z, 1)
Next Z
strTwo = Y
End If
arrNumbers(X) = strTwo
Next X
'Get rest of numbers unchanged'
For X = 16 To 2 Step -2
arrNumbers(X) = Mid(strNum, X, 1)
Next X
strTwo = ""
'Add all the resultant numbers'
For X = 1 To 15
strTwo = Val(strTwo) + Val(arrNumbers(X))
Next X
'take just the righthand digit'
strTwo = Right(strTwo, 1)
If strTwo <> "0" Then strTwo = 10 - strTwo
'Compare it to the last digit in the card number (the Checksum)'
If strTwo = arrNumbers(16) Then
MsgBox "This number is correct"
Else
MsgBox "This number is wrong"
End If
End Sub
I don’t know why some lines come out coloured
Edit: Yes I do it is the punctuation marks for the comment lines making the forum software go a bit funny anyway I have changed it so now all the red lines are purely comments and take no part in the calculation
I have no idea but the number in the pic is obviously made up but it passes the algorithm test because I used the code to find the number needed and just added that as the last digit.
It certainly works for my credit cards anyway.
BTW you can enter the number in blocks of four as shown or put the whole number in any one of the four coloured cells or split it into two as long as the remaining cells are blank and the number is correct reading from left to right it doesn’t care.
