Credit Card Numbers - Validation / Checksum

yytsunamiyy

Well-known Member
Joined
Mar 17, 2008
Messages
963
I have a userform capturing Credit Card Numbers for Visa, Master, Amex and Diners as part of a payment tracking system and would like to check that the entered Card Number is valid before processing the payment through a third-party website to minimize to number of error / invalid card messages.

I suspect there is some kind of checksum built into the cardnr. Any tips on how to check for the validity would be appreciated, including links to relevant sites.

this question is related to an earlier question of mine: http://www.mrexcel.com/forum/showthread.php?t=309862

thank you all

Stephan
 
just a short update - I now made it a one-size-fits-all code for the Luhn Algorithm.

In the first part it checks if the Starting number(s) and length of the Cardnr. entered by the user are matching the selected Cardtype. The actual Luhn Algorithm is found in the second part - CardValidation:

Code:
Private Sub TextBoxCardNr1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim wert As String
Dim CheckNr(1 To 16) As Integer
Dim CheckString As String
Dim CheckPart(1 To 2) As Integer
Dim CheckSum
Dim i, j, k
CheckSum = 0
wert = TextBoxCardNr1.Text
wert = Replace(wert, "-", "")
Me.TextBoxCardNr2.Value = wert



If Me.ComboBoxCardType.Text = "VS" And wert Like "4*" Then
    If Len(wert) = 16 Or Len(wert) = 13 Then
        GoTo CardValidation
    Else
        GoTo ErrorMsgCardInvalid
    End If
   
ElseIf Me.ComboBoxCardType.Text = "MA" And wert Like "5*" Then Exit Sub
    If Len(wert) = 16 Then
        GoTo CardValidation
    Else
        GoTo ErrorMsgCardInvalid
    End If
    
ElseIf Me.ComboBoxCardType.Text = "AE" And wert Like "3*" Then
    If Len(wert) = 15 Then
        If wert Like "34##-####-####-###" Or wert Like "37##-####-####-###" Then
            GoTo CardValidation
        Else
            GoTo ErrorMsgCardtypeWrong
        End If
    Else
        GoTo ErrorMsgCardInvalid
    End If
ElseIf Me.ComboBoxCardType.Text = "DI" And wert Like "3*" Then
    If Len(wert) = 17 Then
        If wert Like "300#-####-####-##" _
        Or wert Like "301#-####-####-##" _
        Or wert Like "302#-####-####-##" _
        Or wert Like "303#-####-####-##" _
        Or wert Like "304#-####-####-##" _
        Or wert Like "305#-####-####-##" _
        Or wert Like "36##-####-####-##" _
        Or wert Like "38##-####-####-##" Then
            
            GoTo CardValidation
           
        Else
            GoTo ErrorMsgCardtypeWrong
        End If
    Else
        GoTo ErrorMsgCardInvalid
    End If

ElseIf Not TextBoxCardNr1.Text = "" Then
    GoTo ErrorMsgCardtypeWrong
End If
          
CardValidation:
    If Len(wert) Mod 2 = 0 Then 'even lenght numbers (16/14)
        
        For i = 1 To Len(wert) '-------read digits in Cardnumber
            CheckNr(i) = VBA.Mid(Me.TextBoxCardNr2.Value, i, 1)
        Next i
        
        For j = Len(wert) - 1 To 1 Step -2 '----double alternate digits starting with right - 1
            CheckNr(j) = CheckNr(j) * 2
            If CheckNr(j) > 8 Then ' if doubled is 2-digit number calculate Sum of digits
                CheckString = CheckNr(j)
                CheckPart(1) = VBA.Left(CheckString, 1)
                CheckPart(2) = VBA.Right(CheckString, 1)
                CheckNr(j) = CheckPart(1) + CheckPart(2)
            End If
        Next j
        
        '------add all CheckNr's to make CheckSum
        For k = 1 To Len(wert)
            CheckSum = CheckSum + CheckNr(k)
        Next k
        
        '------check that Checksum / 10 does not leave remainder - if so CardNr is invalid
        If Not CheckSum Mod 10 = 0 Then
            GoTo ErrorMsgCardInvalid
        Else
            Me.TextBoxCardNr2.SelStart = 0
            Me.TextBoxCardNr2.SelLength = Len(wert)
            TextBoxCardNr2.Copy
            Me.TextBoxCardSecCode.SetFocus
            Exit Sub
        End If
            
    Else 'oddlenght numbers (13/15)
        For i = 1 To Len(wert) '-------read digits in Cardnumber
            CheckNr(i) = VBA.Mid(Me.TextBoxCardNr2.Value, i, 1)
        Next i
        
        For j = Len(wert) - 1 To 2 Step -2 '----double alternate digits starting with right - 1
            CheckNr(j) = CheckNr(j) * 2
            If CheckNr(j) > 8 Then ' if doubled is 2-digit number calculate Sum of digits
                CheckString = CheckNr(j)
                CheckPart(1) = VBA.Left(CheckString, 1)
                CheckPart(2) = VBA.Right(CheckString, 1)
                CheckNr(j) = CheckPart(1) + CheckPart(2)
            End If
        Next j
        
        '------add all CheckNr's to make CheckSum
        For k = 1 To Len(wert)
            CheckSum = CheckSum + CheckNr(k)
        Next k
        
        '------check that Checksum / 10 does not leave remainder - if so CardNr is invalid
        If Not CheckSum Mod 10 = 0 Then
            GoTo ErrorMsgCardInvalid
        Else
            Me.TextBoxCardNr2.SelStart = 0
            Me.TextBoxCardNr2.SelLength = Len(wert)
            TextBoxCardNr2.Copy
            Me.TextBoxCardSecCode.SetFocus
            Exit Sub
        End If
    End If
    Exit Sub


          
ErrorMsgCardtypeWrong:
    
    MsgBox "Esta tarjeta no puede ser de tipo " & Me.ComboBoxCardType.Text & "." & vbCr & _
           "Por favor examinar tipo y numero." & vbCr & vbCr & _
           "Si el numero empieza" & vbCr & _
           "con 3 puede ser AmEx (AE)o Diners (DI)," & vbCr & _
           "con 4 es Visa (VS)" & vbCr & _
           "con 5 es MasterCard (MA).", vbOKOnly Or vbExclamation
    
    
    Exit Sub
    
ErrorMsgCardInvalid:
    MsgBox "Numero ingresado no es valido." & vbCr & vbCr & _
           "Por favor examinar el numero.", vbOKOnly Or vbExclamation
    


    
End Sub
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
I'm sure the code works fine but I'm really having trouble following the flow, mind you that shouldn't matter if the code works.:)

The reason is because your If End If structure combined with all those Gotos appears to have created what is sometimes called spaghetti code.
 
Upvote 0
hm... I see what you mean. Problem is, my roots lie with Basic - as I'm sure I mentioned before. I use GOTO in order to avoid duplicating the validation Code and the possible error messages for each cardtype (I could as well put them in a public sub and call that instead of using GOTO). If you can see an esaier way to check the following is true before running the luhn algorithm I would be more than happy to streamline the code.
<table border="2" bordercolor="#ff0000"><tbody><tr><td valign="bottom" width="148">ARD TYPE </td><td valign="bottom" width="86">Prefix </td><td valign="bottom" width="78">Length </td><td valign="bottom" width="120">Check digit algorithm </td></tr> <tr><td width="148">MASTERCARD</td><td width="86">51-55</td><td width="78">16 </td><td width="120">mod 10</td></tr> <tr><td width="148">VISA</td><td width="86">4</td><td width="78">13, 16 </td><td width="120">mod 10</td></tr> <tr><td width="148">AMEX</td><td width="86">34
37</td><td width="78">15 </td><td width="120">mod 10</td></tr> <tr><td width="148">Diners Club/
Carte Blanche</td><td width="86">300-305
36
38 </td><td width="78">14</td><td width="120">mod 10</td></tr> <tr><td width="148">Discover</td><td width="86">6011</td><td width="78">16 </td><td width="120">mod 10</td></tr> <tr><td width="148">enRoute</td><td width="86">2014
2149</td> <td width="78">15</td><td width="120">any</td></tr> <tr><td width="148">JCB</td><td width="86">3</td><td width="78">16</td> <td width="120">mod 10</td></tr> <tr><td width="148">JCB</td><td width="86">2131
1800</td><td width="78">15 </td><td width="120">mod 10</td></tr></tbody></table>
 
Upvote 0
Well basic was the first programming language I used.

And even back in those days using this sort of redirection was frowned upon.

Remember GoSub.:eek:

I've not full examined the code or the Luhn algorithim - I will when I get some time, might be an interesting project.

By the way I think the main problem I have following the code is the If...End If structure.

Wouldn't a mixture of Select Case and If be more appropriate?
 
Upvote 0
I thought about the Select Case functionality for a bit and came up with the following. Ihope the code is easier to read that way. I also saved the code for the odd lenghts of card numbers - it is not necessary to distinguish the cases. The doubling routine starts at with the number before the last and goes down with stepsize -2 until 1. In Numbers with an odd lenght it starts with an even number - coming down to number 2. Then because stepsize is 2, the indicator j becomes 0 and is therefore outside the range. - another If...end if saved.

Code:
Private Sub TextBoxCardNr1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim wert As String
Dim CardIdNr
Dim CheckNr(1 To 16) As Integer
Dim CheckString As String
Dim CheckPart(1 To 2) As Integer
Dim CheckSum
Dim i, j, k

CheckSum = 0
wert = TextBoxCardNr1.Text
wert = Replace(wert, "-", "")
Me.TextBoxCardNr2.Value = wert
CardIdNr = VBA.Left(wert, 3)

Select Case CardIdNr

Case 400 To 499
    If Me.ComboBoxCardType.Text = "VS" Then
        If Len(wert) = 16 Or Len(wert) = 13 Then
            GoTo CardValidation
        Else
            GoTo ErrorMsgCardInvalid
        End If
    Else
        GoTo ErrorMsgCardtypeWrong
    End If
Case 510 To 559
    If Me.ComboBoxCardType.Text = "MA" Then
        If Len(wert) = 16 Then
            GoTo CardValidation
        Else
            GoTo ErrorMsgCardInvalid
        End If
    Else
        GoTo ErrorMsgCardtypeWrong
    End If
Case 340 To 349, 370 To 379
    If Me.ComboBoxCardType.Text = "AE" Then
        If Len(wert) = 15 Then
            GoTo CardValidation
        Else
            GoTo ErrorMsgCardInvalid
        End If
    Else
        GoTo ErrorMsgCardtypeWrong
    End If
Case 300 To 305, 360 To 369, 380 To 389
    If Me.ComboBoxCardType.Text = "DI" Then
        If Len(wert) = 14 Then
            GoTo CardValidation
        Else
            GoTo ErrorMsgCardInvalid
        End If
    Else
        GoTo ErrorMsgCardtypeWrong
    End If
Case Else
    GoTo ErrorMsgCardtypeWrong
End Select



          
CardValidation:
    
     For i = 1 To Len(wert) '-------read digits in Cardnumber
         CheckNr(i) = VBA.Mid(Me.TextBoxCardNr2.Value, i, 1)
     Next i
     
     For j = Len(wert) - 1 To 1 Step -2 '----double alternate digits starting with right - 1
         CheckNr(j) = CheckNr(j) * 2
         If CheckNr(j) > 8 Then ' if doubled is 2-digit number calculate Sum of digits
             CheckString = CheckNr(j)
             CheckPart(1) = VBA.Left(CheckString, 1)
             CheckPart(2) = VBA.Right(CheckString, 1)
             CheckNr(j) = CheckPart(1) + CheckPart(2)
         End If
     Next j
     
     '------add all CheckNr's to make CheckSum
     For k = 1 To Len(wert)
         CheckSum = CheckSum + CheckNr(k)
     Next k
     
     '------check that Checksum / 10 does not leave remainder - if so CardNr is invalid
     If Not CheckSum Mod 10 = 0 Then
         GoTo ErrorMsgCardInvalid
     Else
         Me.TextBoxCardNr2.SelStart = 0
         Me.TextBoxCardNr2.SelLength = Len(wert)
         TextBoxCardNr2.Copy
         Me.TextBoxCardSecCode.SetFocus
         Exit Sub
     End If
    
    Exit Sub


          
ErrorMsgCardtypeWrong:
    
    MsgBox "Esta tarjeta no puede ser de tipo " & Me.ComboBoxCardType.Text & "." & vbCr & _
           "Por favor examinar tipo y numero." & vbCr & vbCr & _
           "Si el numero empieza" & vbCr & _
           "con 3 puede ser AmEx (AE)o Diners (DI)," & vbCr & _
           "con 4 es Visa (VS)" & vbCr & _
           "con 5 es MasterCard (MA).", vbOKOnly Or vbExclamation
    
    
    Exit Sub
    
ErrorMsgCardInvalid:
    
    MsgBox "Numero ingresado no es valido." & vbCr & vbCr & _
           "Por favor examinar el numero.", vbOKOnly Or vbExclamation
     
End Sub
 
Upvote 0

Forum statistics

Threads
1,226,527
Messages
6,191,574
Members
453,665
Latest member
WaterWorks

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