I can not solve this one (Userform Focus)

J

johnsonk

Board Regular
Joined
Feb 4, 2019
Messages
172
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
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
have you tried setting the focus in the textbox_Exit event ?
 
Upvote 0
johnsonk said:
VBA Code: 
Private Sub UserForm_Initialize()
.....
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
Click to expand...
This is not an answer to your question, but I just wanted to let you know that instead of putting all these lines of code in the Initialize event, you can go to your UserForm in the VB editor, select all those controls (CTRL-click them one at a time) and then set the Visible property in the Properties Window to False and they will all be hidden at run time automatically... no code needed. Note - they will still be visible in the UserForm within the VB editor, but not at run-time.
 
Upvote 0
Rick Rothstein: Thank you for that that works great.

NoSparks: I have tried the Exit event and setting the focus but still does not work :mad:

VBA Code: 
Private Sub TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox1.Value = "" Or TextBox10.Value = "" Then Exit Sub
If TextBox1.Value = TextBox10.Value Then
TextBox10.BackColor = vbGreen
End If
TextBox11.SetFocus
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

Regards
 
Upvote 0
just add the Exit event to what you already had
VBA Code: 
Private Sub TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Me.TextBox11.SetFocus
End Sub
 
Upvote 0
Hi NoSparks tried your suggestion but still will not jump to next textbox this is really starting to do my head in now.:mad:

VBA Code: 
Private Sub TextBox10_AfterUpdate()
If TextBox1.Value = "" Or TextBox10.Value = "" Then Exit Sub
If TextBox1.Value = TextBox10.Value Then
TextBox10.BackColor = vbGreen
End If
TextBox11.SetFocus
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 TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.TextBox11.SetFocus
End Sub
 
Upvote 0
You got to have something else going on here.
Can you share a copy of your workbook (sanitized of course) so we're both dealing with the same thing?
 
Upvote 0
Well, thanks for sharing that.

I can't run your program the way you would as don't have all thats required and get a whole mess of run-time errors.
Running frm1 by itself I can see you'd need to check for textbox11 being visible prior to setting the focus.
try
VBA Code: 
Private Sub TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.TextBox11.Visible Then Me.TextBox11.SetFocus
End Sub

Beyond that all I can do is wish you luck with the project.
 
Upvote 0
your tab order is right and I can't see why focus is not going to textbox11
because of things sometimes not being visible it's probably best not to specify where to set the focus
just out of curiosity try it like this and see what happens. In theory it will be one or the other.
VBA Code: 
Private Sub TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.TextBox11.Visible Then
        Me.TextBox11.SetFocus
    Else
        MsgBox "TextBox11 is not visible"
    End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Clling a module process
2
Replies
11
Views
622
ipbr21054
I
I
  • Solved
Show or Hide Textbox advice
Replies
8
Views
636
dmt32
D
I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
201
ipbr21054
I
P
  • Question Question
Copy data from textbox and Combobox into Listbox
Replies
1
Views
381
Patriot2879
P
P
  • Solved
Code doesn't go on a new line (emptyRow)
Replies
8
Views
398
Fluff
Fluff

Forum statistics

Threads
1,223,737
Messages
6,174,206
Members
452,551
Latest member
croud

Share this page

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