VBA - Code to check EAN13 checkdigit not working?

[NessPJ]

Hi,

I made a sheet with the VBA code posted below.
In there i have 2 methods for checking/recalculating a EAN13 code checkdigit.
But both methods are not correct according to the GS1 website.
I tried looking online (including these forums) to find an improved version of the code, but i could not find it.

Both the CheckDigit and calculateCheckdigit functions use a different approach. But they both come with FALSE results when the EAN13 code is actually correct.
Example: 3270161023430 (where the checkdigit is the last 0 and GS1 validates that this code is correct).

Can anyone help me to get a working/correct EAN13 checkdigit calculator?

Option Private Module

    Public Const Password As String = "1234"

Private Sub Start()

Dim ChecklistLR As Long
Dim Digit As String
Dim Result As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Start routine

PROTOFF (Password)

Sheets("Controle").Range("C4:C5000").ClearContents

ChecklistLR = Sheets("Controle").Range("B65534").End(xlUp).Row

i = 0

For i = 4 To ChecklistLR Step 1
   
    Digit = Sheets("Controle").Range("B" & i).value
   
    Result = IsCodeValid2(Digit)        'i also tried IsCodeValid(Digit)
   
    Sheets("Controle").Range("C" & i).value = Result
   
Next i

'Einde routine

PROTON (Password)
  
Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

Function IsCodeValid(sNumber As String) As Boolean

    On Error Resume Next
    If Len(sNumber) < 8 Then Exit Function
    IsCodeValid = (Right(sNumber, 1) = IsCodeValid = CheckDigit(Left(sNumber, Len(sNumber) - 1)))
    If Err.Number <> 0 Then Debug.Print Now, sNumber, Err.Number, Err.Description
   
End Function

Function CheckDigit(ByVal gtin As String) As String

'general purpose check digit calculator
' given all figures except last one, calculate check digit as used for GTIN-8, GTIN-12, EAN13, EDI GLN, etc ...
'parameter: number as string, WITHOUT the last digit
'works with string length up to 254 char
' returns: the last digit
'author: Patrick Honorez - www.idevlop.com
' notes: provided without any warranties
' Copyleft as long as you keep this header intact
'help for algorithm can be found here:
' http://www.gs1.org/barcodes/support/check_digit_calculator#how

    Dim m() As String, lSum As Long, i As Integer
    Dim chk As Integer, large As Long, mult As Byte
    'store string into an array
    m = Split(StrConv(gtin, vbUnicode), Chr(0))
    mult = 3     'multiply initial value is 3
    ' calc right to left to start with 3 as multiply
    For i = UBound(m) - 1 To 0 Step -1    'ignore last value of array: it's always = to chr (0)
        lSum = lSum + Val(m(i)) * mult
        If mult = 3 Then mult = 1 Else mult = 3 'swap multiply value between 3 and 1
    Next i
     ' find difference between lSum and the 10 that's equal or greater
    wide = (lSum \ 10) * 10
    If large < lSum Then large = large + 10
    chk = large - lSum
    CheckDigit = CStr(chk)
   
End Function

Function IsCodeValid2(sNumber As String) As Boolean

    On Error Resume Next
    If Len(sNumber) < 8 Then Exit Function
    IsCodeValid2 = calculateCheckDigit(Left(sNumber, Len(sNumber) - 1))
    If Err.Number <> 0 Then Debug.Print Now, sNumber, Err.Number, Err.Description
   
End Function

Function calculateCheckDigit(value)

    lenval = Len(value)
    factor = 3
    Sum = 0
    For Index = lenval To 1 Step -1
        Sum = Sum + (CInt(Mid(value, Index, 1)) * factor)
        factor = 4 - factor
    Next
    calculateCheckDigit = ((1000 - Sum) Mod 10)
   
End Function

Private Function PROTOFF(Password As String)
   
' Loop through all sheets in the workbook and unprotect

    For i = 1 To Sheets.Count

    Sheets(i).Unprotect (Password)

    Next i

End Function


Private Function PROTON(Password As String)

' Loop through all sheets in the workbook and protect
   
    For i = 1 To Sheets.Count
   
    Sheets(i).Protect DrawingObjects:=True, Contents:=True, AllowUsingPivotTables:=True, Scenarios:=True _
    , AllowFiltering:=True, Password:=Password

    Next i

End Function

 

[yky]

You need to start from UBound(m) - 2 because the array index starts from 0, not 1.

    For i = UBound(m) - 2 To 0 Step -1    'ignore last value of array: it's always = to chr (0)