need vb code to verify barcode check digit in Excel Userform textbox

dmcgee57

New Member
Joined
Dec 29, 2009
Messages
7
I am new to VB .. I have a great vb code that will validate barcode check digit when I post the code in the worksheet, but I need it to work inside of an userform. The code is ....

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim cell As Range
Dim s As String
Dim i As Long
Dim iSum As Long
Set r = Intersect(Target, Columns("L:N"))
If r Is Nothing Then Exit Sub
On Error GoTo Oops
Application.EnableEvents = False
For Each cell In r
With cell
s = Replace(.Text, " ", "")
If Not IsNumeric(s) Then
.Interior.ColorIndex = 0

Else
Select Case Len(s)
Case 8
.Value = Format(Val(s), "0000 0000")
.Interior.ColorIndex = xlColorIndexNone
Case 12
.Value = Format(Val(s), "000000 000000")
.Interior.ColorIndex = xlColorIndexNone
Case 13
.Value = Format(Val(s), "0 000000 000000")
.Interior.ColorIndex = xlColorIndexNone
Case 14
.Value = Format(Val(s), "0 00 00000 000000")
.Interior.ColorIndex = xlColorIndexNone
Case Else
.Interior.ColorIndex = 3
End Select
If .Interior.ColorIndex = xlColorIndexNone Then
iSum = 0
For i = 1 To Len(s) - 1
iSum = iSum + Val(Mid(s, i, 1)) * IIf(i And 1, 3, 1)
Next i 'formatting in the code.
iSum = WorksheetFunction.Ceiling(iSum, 10) - iSum
If Val(Right(s, 1)) <> iSum Then .Interior.ColorIndex = 3
If Val(Right(s, 1)) <> iSum Then MsgBox ("Check Digit Failed. Retry"), vbRetryCancel
End If
End If
End With
Next cell
Oops:
Application.EnableEvents = True
End Sub

How can I rearrange this code to work inside of userform .

Thanks for any help
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Try (untested):

Code:
Private Sub CommandButton1_Click()
    Dim s As String
    Dim i As Long
    Dim iSum As Long
    With TextBox1
        s = Replace(.Text, " ", "")
        If IsNumeric(s) Then
            iSum = 0
            For i = 1 To Len(s) - 1
                iSum = iSum + Val(Mid(s, i, 1)) * IIf(i And 1, 3, 1)
            Next i
            iSum = WorksheetFunction.Ceiling(iSum, 10) - iSum
            If Val(Right(s, 1)) <> iSum Then MsgBox ("Check Digit Failed. Retry"), vbRetryCancel
        End If
    End With
End Sub
 
Upvote 0
Sorry ... does not work. I copy code into the Userform. Data entered in to form was mapped into the data spreadsheet (even when the check digit did not match) also, No message for retry.
 
Upvote 0

Forum statistics

Threads
1,224,613
Messages
6,179,894
Members
452,948
Latest member
Dupuhini

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