Barcode Len in textbox

[johnsonk]

Hi,

I am having problems trying to get the below to work, when I scan the barcode it stops after the first digit I have tried other subs with no joy can anyone help. I just want it to show error msg if the length of the barcode is wrong.

Private Sub textbox2_Change()
Dim erow As Long
Application.DisplayAlerts = False
If Len(TextBox2.Value) < 46 Then
MsgBox "Too short!"
Else
If Len(TextBox2.Value) > 46 Then
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 2) = TextBox1.Text
Cells(erow, 3) = TextBox2.Text
Cells(erow, 7) = TextBox3.Text
Cells(erow, 8) = TextBox4.Text
Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Date
Cells(erow, 4).FormulaR1C1 = "=mid(rc[-1],4,4)"
Cells(erow, 5).FormulaR1C1 = "=mid(rc[-2],8,4)"
Cells(erow, 6).FormulaR1C1 = "=mid(rc[-3],30,6)"
TextBox2.Text = ""
TextBox3.Text = ""
TextBox2.Visible = True
TextBox4.Text = ""
TextBox1.Visible = True
TextBox3.Visible = False
TextBox4.Visible = False
Label3.Visible = False
Label4.Visible = False
Label5.Visible = False
Label6.Visible = False
Range("A1").End(xlDown).Select
Application.DisplayAlerts = True
TextBox2.SetFocus
End If
End If
End Sub

Regards

 

[DanteAmor]

Replace your event change for this.
Configure your scanner to send an enter after capturing.

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  Dim erow As Long
  Application.DisplayAlerts = False
  If Len(TextBox2.Value) <= 46 Then
    MsgBox "Too short!"
    Cancel = True
  Else
    erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(erow, 2) = TextBox1.Text
    Cells(erow, 3) = TextBox2.Text
    Cells(erow, 7) = TextBox3.Text
    Cells(erow, 8) = TextBox4.Text
    Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Date
    Cells(erow, 4).FormulaR1C1 = "=mid(rc[-1],4,4)"
    Cells(erow, 5).FormulaR1C1 = "=mid(rc[-2],8,4)"
    Cells(erow, 6).FormulaR1C1 = "=mid(rc[-3],30,6)"
    TextBox2.Text = ""
    TextBox3.Text = ""
    TextBox2.Visible = True
    TextBox4.Text = ""
    TextBox1.Visible = True
    TextBox3.Visible = False
    TextBox4.Visible = False
    Label3.Visible = False
    Label4.Visible = False
    Label5.Visible = False
    Label6.Visible = False
    Range("A1").End(xlDown).Select
    Application.DisplayAlerts = True
    Cancel = False
  End If
End Sub

 

[johnsonk]

Hi DanteAmor,

When my userform opens the msgbox pops up then I get an error when I debug it highlights the textbox1.setfocus in the userform activate below is the full code for the userform

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim erow As Long
Application.DisplayAlerts = False
If Len(TextBox2.Value) <= 46 Then
MsgBox "Too short!"
Cancel = True
Else
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 2) = TextBox1.Text
Cells(erow, 3) = TextBox2.Text
Cells(erow, 7) = TextBox3.Text
Cells(erow, 8) = TextBox4.Text
Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Date
Cells(erow, 4).FormulaR1C1 = "=mid(rc[-1],4,4)"
Cells(erow, 5).FormulaR1C1 = "=mid(rc[-2],8,4)"
Cells(erow, 6).FormulaR1C1 = "=mid(rc[-3],30,6)"
TextBox2.Text = ""
TextBox3.Text = ""
TextBox2.Visible = True
TextBox4.Text = ""
TextBox1.Visible = True
TextBox3.Visible = False
TextBox4.Visible = False
Label3.Visible = False
Label4.Visible = False
Label5.Visible = False
Label6.Visible = False
Range("A1").End(xlDown).Select
Application.DisplayAlerts = True
Cancel = False
End If
End Sub

Private Sub commandbutton1_Click()
Dim erow As Long
Application.DisplayAlerts = False
If Len(TextBox4.Value) < 6 Then
TextBox4.Text = ""
TextBox4.SetFocus
MsgBox "Please Enter 6 Digits For Weight example( 002500 )"
Else
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 2) = TextBox1.Text
Cells(erow, 7) = TextBox3.Text
Cells(erow, 6) = TextBox4.Text
Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Now
TextBox3.Text = ""
TextBox4.Text = ""
TextBox1.Visible = True
TextBox2.Visible = False
TextBox3.Visible = True
TextBox4.Visible = True
Label3.Visible = True
Label4.Visible = True
Label5.Visible = True
Label6.Visible = True
Range("A1").End(xlDown).Select
TextBox1.Visible = True
TextBox2.Visible = True
TextBox3.Visible = False
TextBox4.Visible = False
Label3.Visible = False
Label4.Visible = False
Label5.Visible = False
Label6.Visible = False
Application.DisplayAlerts = True
TextBox2.SetFocus
End If
End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
ActiveWorkbook.Save
Application.Quit
End Sub

Private Sub CommandButton3_Click()
Login.Show
Unload UserForm1
End Sub

Private Sub CommandButton4_Click()
Unload UserForm1
ActiveWindow.DisplayWorkbookTabs = False
Sheet2.Activate
End Sub

Private Sub CommandButton5_Click()
TextBox2.Visible = False
Label2.Visible = False
TextBox3.Visible = True
TextBox4.Visible = True
Label3.Visible = True
Label4.Visible = True
Label5.Visible = True
Label6.Visible = True
TextBox3.SetFocus
End Sub

Private Sub UserForm_Activate()
Me.StartUpPosition = 0
Me.Top = Application.Top + 5
Me.Left = Application.Left + Application.Width - Me.Width - 5
TextBox3.Visible = False
TextBox4.Visible = False
Label3.Visible = False
Label4.Visible = False
Label5.Visible = False
Label6.Visible = False
TextBox1.SetFocus
End Sub

Private Sub UserForm_QueryClose _
(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "Clicking the Close button does not work."
Cancel = True
End If
End Sub

Regards

 

[DanteAmor]

Change the TabIndex property of Textbox1 to 0 and the property of Textbox2 to 1

 

[johnsonk]

Doing that does not work ?

 

[DanteAmor]

Doing that does not work

Does it send you the same error message?