Macro for Excel calculating the checkdigit of a number using Luhn's algorithm

Posted on 2005-04-08
Last Modified: 2012-08-13
I am searching a Macro for Excel to calculate the checkdigit of a series of 20K numbers. The numbers are like this: 35140513000637 and the checkdigit is to be calculated using the Luhn's algorithm. The result for the sample is 351405130006378. The Macro of course implements the Luhn's algorithm.

Question by:luigicamporesi
    LVL 9

    Accepted Solution


    try the following

    on the worksheet ..
    column a has the original number
    column b will hold the result

    mod10 sub is the driver
    lastrow is a function that returns the last row on the worksheet
    calcModulus10 returns the check digit

    Sub Mod10()

        Dim strCD As String
        For r = 1 To LastRow(ActiveSheet)
            With ActiveSheet
                strCD = calcModulus10(ActiveSheet.Cells(r, 1))
                ActiveSheet.Cells(r, 2).NumberFormat = "@"
                ActiveSheet.Cells(r, 2) = ActiveSheet.Cells(r, 1) & strCD
            End With
        Next r
    End Sub
    Function LastRow(ws As Worksheet) As Single

        'uses worksheet object
        'returns last used row
        On Error Resume Next
        With ws
          LastRow = .Cells.Find(What:="*", _
            SearchDirection:=xlPrevious, _
        End With
    End Function

    Function calcModulus10(ByVal sNumber As String) As Integer
        Dim tmpTotal As Integer
        Dim i As Integer, f As Byte, tmpStr As String
        Dim mdNums() As Integer
        For i = 1 To Len(sNumber)
          f = f + 1
          If f = 2 Then
            tmpStr = CInt(Mid$(sNumber, i, 1)) * 2
            If Len(tmpStr) > 1 Then
              tmpTotal = tmpTotal + CInt(Mid$(tmpStr, 1, 1)) + CInt(Mid$(tmpStr, 2, 1))
              tmpTotal = tmpTotal + CInt(tmpStr)
            End If
            tmpStr = ""
            f = 0
            tmpTotal = tmpTotal + CInt(Mid$(sNumber, i, 1))
          End If
        Next i
        If Right$(CStr(tmpTotal), 1) = "0" Then
          tmpTotal = 0
          tmpTotal = ((tmpTotal + 10) - CInt(Right$(CStr(tmpTotal), _
        1))) - tmpTotal
        End If
        calcModulus10 = tmpTotal
    End Function

    Author Comment

    Dear dmanq, thank you very mch for your help. I am really ignorant in this field, and you have saved me at least 20 days of hard work. Thanks again!!!!!
    LVL 9

    Expert Comment

    You are most welcome!

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Maximize Your Threat Intelligence Reporting

    Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

    If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
    When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
    Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
    Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

    759 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    13 Experts available now in Live!

    Get 1:1 Help Now