I can not solve this one (Userform Focus)

johnsonk

Board Regular
Joined
Feb 4, 2019
Messages
169
Hi, I have a userform with several textboxes and comboboxes some textboxes are populated from a closed workbook (Database) when the one of comboboxes is used. When I scan in the first textbox it is not moving to the next textbox the scanner is set correct the tabs order is set correct now when i run the form in the editor and scan in the first textbox it jumps to the next and works perfect but as soon as I close and reopen the workbook it does not work, this is the only issue I need to resolve now then my project is complete but I can not figure out what the issue is. Has anyone come across this issue before ?
1601059143324.png


VBA Code:
Private Sub UserForm_Initialize()
With Application
.WindowState = xlMaximized
Zoom = Int(.Width / Me.Width * 100)
Zoom = Int(.Height / Me.Height * 90)
Width = .Width
Height = .Height
End With
With GetObject("P:\Stores\DataBase.xlsm")
ComboBox3.List = .Sheets("ALL").Range("B7:B500").Value
End With
Label2.Visible = False
Label3.Visible = False
Label13.Visible = False
Label13.Visible = False
Label14.Visible = False
Label15.Visible = False
Label16.Visible = False
Label17.Visible = False
Label18.Visible = False
Label19.Visible = False
Label20.Visible = False
Label21.Visible = False
Label22.Visible = False
Label23.Visible = False
Label24.Visible = False
ComboBox2.Visible = False
ComboBox3.Visible = False
TextBox8.Visible = False
TextBox9.Visible = False
TextBox10.Visible = False
TextBox11.Visible = False
TextBox12.Visible = False
TextBox13.Visible = False
TextBox14.Visible = False
TextBox15.Visible = False
TextBox16.Visible = False
TextBox17.Visible = False
TextBox18.Visible = False
TextBox19.Visible = False
End Sub
Private Sub ComboBox1_Change()
Worksheets(ComboBox1.Value).Select
    Label2.Visible = True
    ComboBox2.Visible = True
End Sub
Private Sub ComboBox2_Change()
    Label3.Visible = True
ComboBox3.Visible = True

If ComboBox2.Value = "IN" Then
Label14.Visible = True
TextBox9.Visible = True
End If

End Sub
Private Sub ComboBox3_Change()
With GetObject("P:\Stores\DataBase.xlsm")
    TextBox1.Value = .Sheets("ALL").Range("A" & ComboBox3.ListIndex + 7).Value
TextBox2.Value = .Sheets("ALL").Range("C" & ComboBox3.ListIndex + 7).Value
TextBox3.Value = .Sheets("ALL").Range("O" & ComboBox3.ListIndex + 7).Value
TextBox4.Value = .Sheets("ALL").Range("N" & ComboBox3.ListIndex + 7).Value
TextBox5.Value = .Sheets("ALL").Range("T" & ComboBox3.ListIndex + 7).Value
Label9.Visible = True
Label10.Visible = True
ComboBox4.Visible = True
TextBox6.Visible = True

    End With
    Workbooks("DataBase").Close

If TextBox3.Value = "" Then
Label11.Visible = False
Label12.Visible = False
Label18.Visible = False
Label19.Visible = False
Label20.Visible = False
    Label21.Visible = False
    TextBox7.Visible = False
TextBox14.Visible = False
TextBox15.Visible = False
TextBox16.Visible = False
    TextBox17.Visible = False
    ComboBox5.Visible = False

TextBox3.Text = "No Promo"

Me.Image1.Picture = LoadPicture("\\Fps16\Stores\PackScanImages\" & TextBox3.Value & ".JPG")
Else

Me.Image1.Picture = LoadPicture("\\Fps16\Stores\PackScanImages\" & TextBox3.Value & ".JPG")

Label11.Visible = True
Label12.Visible = True
Label18.Visible = True
Label19.Visible = True
Label20.Visible = True
    Label21.Visible = True
    TextBox7.Visible = True
TextBox14.Visible = True
TextBox15.Visible = True
TextBox16.Visible = True
    TextBox17.Visible = True
    ComboBox5.Visible = True

End If
End Sub
Private Sub ComboBox4_Change()
If ComboBox4 = "SLEEVES" Then
Label13.Visible = True
TextBox8.Visible = True
Else
Label13.Visible = False
TextBox8.Visible = False
End If
End Sub
Private Sub TextBox6_Change()
If TextBox6.Value = "" Then
TextBox10.Visible = False
TextBox11.Visible = False
TextBox12.Visible = False
TextBox13.Visible = False
Label15.Visible = False
Label16.Visible = False
Label17.Visible = False
Label18.Visible = False
Else
If TextBox6.Value = 1 Then
TextBox10.Visible = True
TextBox11.Visible = False
TextBox12.Visible = False
TextBox13.Visible = False
Label15.Visible = True
Label16.Visible = False
Label17.Visible = False
Label18.Visible = False
Else
If TextBox6.Value = 2 Then
TextBox10.Visible = True
TextBox11.Visible = True
TextBox12.Visible = False
TextBox13.Visible = False
Label15.Visible = True
Label16.Visible = True
Label17.Visible = False
Label18.Visible = False
Else
If TextBox6.Value = 3 Then
TextBox10.Visible = True
TextBox11.Visible = True
TextBox12.Visible = True
TextBox13.Visible = False
Label15.Visible = True
Label16.Visible = True
Label17.Visible = True
Label18.Visible = False
Else
If TextBox6.Value = 4 Then
TextBox10.Visible = True
TextBox11.Visible = True
TextBox12.Visible = True
TextBox13.Visible = True
Label15.Visible = True
Label16.Visible = True
Label17.Visible = True
Label18.Visible = True
End If
End If
End If
End If
End If
End Sub
Private Sub TextBox10_AfterUpdate()
If TextBox1.Value = "" Or TextBox10.Value = "" Then Exit Sub
If TextBox1.Value = TextBox10.Value Then
TextBox10.BackColor = vbGreen
End If
If TextBox10.BackColor = vbRed Then
Application.Speech.Speak "FAIL"
Dim sPath As String
result = MsgBox("THIS CODE DOES NOT MATCH THE PRICE SHEET", vbOKOnly + vbCritical, "WARNING")
If result = vbOK Then
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim wb As Workbook
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "WARNING" & vbNewLine & vbNewLine & _
"There has been a no match scanning error" & vbNewLine & vbNewLine & _
"LINE NUMBER: " & ComboBox1.Value & vbNewLine & _
"PRODUCT CODE: " & ComboBox3.Value & vbNewLine & _
"PRODUCT DESCRIPTION: " & TextBox2.Value & vbNewLine & _
"LABEL QTY SELECTED: " & TextBox6.Value & vbNewLine & _
"LABEL CODE ON PRICE SHEET: " & TextBox1.Value & vbNewLine & _
"LABEL CODE 1 Scanned: " & TextBox10.Value

On Error Resume Next
With xOutMail
.To = ""
'.CC = ""
.Subject = "Stores label code scanning error"
.Body = xMailBody
.Attacments = ActiveSheet
.Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing

TextBox10.Text = ""
TextBox10.BackColor = &HFFFFFF
End If
End If
End Sub
Private Sub TextBox11_AfterUpdate()
If TextBox1.Value = "" Or TextBox11.Value = "" Then Exit Sub
If TextBox1.Value = TextBox11.Value Then
TextBox11.BackColor = vbGreen
End If
If TextBox11.BackColor = vbRed Then
Application.Speech.Speak "FAIL"
Dim sPath As String
result = MsgBox("THIS CODE DOES NOT MATCH THE PRICE SHEET", vbOKOnly + vbCritical, "WARNING")
If result = vbOK Then
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim wb As Workbook
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "WARNING" & vbNewLine & vbNewLine & _
"There has been a no match scanning error" & vbNewLine & vbNewLine & _
"LINE NUMBER: " & ComboBox1.Value & vbNewLine & _
"PRODUCT CODE: " & ComboBox3.Value & vbNewLine & _
"PRODUCT DESCRIPTION: " & TextBox2.Value & vbNewLine & _
"LABEL QTY SELECTED: " & TextBox6.Value & vbNewLine & _
"LABEL CODE ON PRICE SHEET: " & TextBox1.Value & vbNewLine & _
"LABEL CODE 1 Scanned: " & TextBox10.Value & vbNewLine & _
"LABEL CODE 2 Scanned: " & TextBox11.Value

On Error Resume Next
With xOutMail
.To = ""
'.CC = ""
.Subject = "Stores label code scanning error"
.Body = xMailBody
.Attacments = ActiveSheet
.Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing

TextBox10.Text = ""
TextBox10.BackColor = &HFFFFFF
TextBox11.Text = ""
TextBox11.BackColor = &HFFFFFF
End If
End If
End Sub
Private Sub TextBox12_AfterUpdate()
If TextBox1.Value = "" Or TextBox12.Value = "" Then Exit Sub
If TextBox1.Value = TextBox12.Value Then
TextBox12.BackColor = vbGreen
End If
If TextBox12.BackColor = vbRed Then
Application.Speech.Speak "FAIL"
Dim sPath As String
result = MsgBox("THIS CODE DOES NOT MATCH THE PRICE SHEET", vbOKOnly + vbCritical, "WARNING")
If result = vbOK Then
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim wb As Workbook
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "WARNING" & vbNewLine & vbNewLine & _
"There has been a no match scanning error" & vbNewLine & vbNewLine & _
"LINE NUMBER: " & ComboBox1.Value & vbNewLine & _
"PRODUCT CODE: " & ComboBox3.Value & vbNewLine & _
"PRODUCT DESCRIPTION: " & TextBox2.Value & vbNewLine & _
"LABEL QTY SELECTED: " & TextBox6.Value & vbNewLine & _
"LABEL CODE ON PRICE SHEET: " & TextBox1.Value & vbNewLine & _
"LABEL CODE 1 Scanned: " & TextBox10.Value & vbNewLine & _
"LABEL CODE 2 Scanned: " & TextBox11.Value & vbNewLine & _
"LABEL CODE 3 Scanned: " & TextBox12.Value

On Error Resume Next
With xOutMail
.To = ""
'.CC = ""
.Subject = "Stores label code scanning error"
.Body = xMailBody
.Attacments = ActiveSheet
.Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing

TextBox10.Text = ""
TextBox10.BackColor = &HFFFFFF
TextBox11.Text = ""
TextBox11.BackColor = &HFFFFFF
TextBox12.Text = ""
TextBox12.BackColor = &HFFFFFF
End If
End If
End Sub
Private Sub TextBox13_AfterUpdate()
If TextBox1.Value = "" Or TextBox13.Value = "" Then Exit Sub
If TextBox1.Value = TextBox13.Value Then
TextBox13.BackColor = vbGreen
End If
If TextBox13.BackColor = vbRed Then
Application.Speech.Speak "FAIL"
Dim sPath As String
result = MsgBox("THIS CODE DOES NOT MATCH THE PRICE SHEET", vbOKOnly + vbCritical, "WARNING")
If result = vbOK Then
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim wb As Workbook
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "WARNING" & vbNewLine & vbNewLine & _
"There has been a no match scanning error" & vbNewLine & vbNewLine & _
"LINE NUMBER: " & ComboBox1.Value & vbNewLine & _
"PRODUCT CODE: " & ComboBox3.Value & vbNewLine & _
"PRODUCT DESCRIPTION: " & TextBox2.Value & vbNewLine & _
"LABEL QTY SELECTED: " & TextBox6.Value & vbNewLine & _
"LABEL CODE ON PRICE SHEET: " & TextBox1.Value & vbNewLine & _
"LABEL CODE 1 Scanned: " & TextBox10.Value & vbNewLine & _
"LABEL CODE 2 Scanned: " & TextBox11.Value & vbNewLine & _
"LABEL CODE 3 Scanned: " & TextBox12.Value & vbNewLine & _
"LABEL CODE 4 Scanned: " & TextBox13.Value

On Error Resume Next
With xOutMail
.To = ""
'.CC = ""
.Subject = "Stores label code scanning error"
.Body = xMailBody
.Attacments = ActiveSheet
.Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing

TextBox10.Text = ""
TextBox10.BackColor = &HFFFFFF
TextBox11.Text = ""
TextBox11.BackColor = &HFFFFFF
TextBox12.Text = ""
TextBox12.BackColor = &HFFFFFF
TextBox13.Text = ""
TextBox13.BackColor = &HFFFFFF

End If
End If
End Sub
 

johnsonk

Board Regular
Joined
Feb 4, 2019
Messages
169
NoSparks, Thank you for trying and for your time. Has anyone else got any ideas what is causing this issue..
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

Watch MrExcel Video

Forum statistics

Threads
1,127,107
Messages
5,622,782
Members
415,927
Latest member
vedasinternational

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
Top