Userform won't close

gmessler

New Member
Joined
Jul 1, 2016
Messages
5
Hello,

I can't get my userform to close because of a combobox_exit that requires an entry.
if I comment the block out the form closes fine so I know Unload works.
I can manually close the form with the X in the top right corner but Unload me doesn't work.
Maybe there's a better way to validate the entries?

I've included a screenshot of the form as well as my current code.

I've created a sheet that has barcodes for Carrier (CARxx, SHPxx, RCPxx)
The comboboxes will only accept barcodes for their type of input but any value (except CAR, SHP, and RCP) can be manually input

The reason for the logout is that a user must enter their login information (on a module) that is passed to this form. Then they can log packages until they log out.

Any help would be appreciated.

Thanks,



VBA Code:
Private Sub LogoutButton_Click()
    
    Unload Me

End Sub

Private Sub UserForm_Initialize()
    Qty = 1
End Sub

Private Sub CancelButton_Click()
    CarrierComboBox.Value = ""
    CarrierRef.Value = ""
    ShipperComboBox.Value = ""
    RecipientComboBox.Value = ""
    PORef.Value = ""
    Qty.Value = 1
    CarrierComboBox.SetFocus
End Sub

Private Sub CarrierComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    x = Left(CarrierComboBox.Value, 3)
    If x = "SHP" Or x = "RCP" Or x = "RCV" Then
        CarrierComboBox.BackColor = rgbPink
        ErrorLbl = "Please Scan Correct code or enter a proper carrier"
        ErrorLbl.BackColor = rgbPink
        CarrierComboBox.SelStart = 0
        CarrierComboBox.SelLength = Len(CarrierComboBox.Value)
        Cancel = True
    End If
End Sub

Private Sub CarrierComboBox_AfterUpdate()
    enteredvalue = Left(CarrierComboBox.Value, 3)
    If enteredvalue = "CAR" Then
        CarrierComboBox.BackColor = rgbWhite
        ErrorLbl = ""
        ErrorLbl.BackColor = Me.BackColor
        
        x = Me.CarrierComboBox.Value
        Y = "*" & x & "*"
        botrow = Sheets("validation").Cells(Sheets("validation").Rows.Count, 1).End(xlUp).Row
        For Each compval In Sheets("validation").Range("A2:A" & botrow)
            If compval = Y Then
                newval = compval.Offset(0, 1).Value
                CarrierComboBox.Value = newval
                Exit For
            End If
        Next

    End If
        CarrierComboBox.BackColor = rgbWhite
        ErrorLbl = ""
        ErrorLbl.BackColor = Me.BackColor

End Sub

Private Sub CarrierComboBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
       
       If CarrierComboBox.Value = "" Then
            CarrierComboBox.BackColor = rgbPink
            ErrorLbl = "Entry Required.  Scan barcode or enter Carrier Name"
            ErrorLbl.BackColor = rgbPink
            CarrierComboBox.SelStart = 0
            CarrierComboBox.SelLength = Len(CarrierComboBox.Value)
            Cancel = True
        End If
End Sub

Private Sub ShipperComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    x = Left(ShipperComboBox.Value, 3)
    If x = "CAR" Or x = "RCP" Or x = "RCV" Then
        ShipperComboBox.BackColor = rgbPink
        ErrorLbl = "Please Scan Correct code or enter a proper Shipper"
        ErrorLbl.BackColor = rgbPink
        ShipperComboBox.SelStart = 0
        ShipperComboBox.SelLength = Len(ShipperComboBox.Value)
        Cancel = True
    End If

End Sub

Private Sub ShipperComboBox_AfterUpdate()
    enteredvalue = Left(ShipperComboBox.Value, 3)
    If enteredvalue = "ShP" Then
        ShipperComboBox.BackColor = rgbWhite
        ErrorLbl = ""
        ErrorLbl.BackColor = Me.BackColor
        
        x = Me.ShipperComboBox.Value
        Y = "*" & x & "*"
        botrow = Sheets("validation").Cells(Sheets("validation").Rows.Count, 4).End(xlUp).Row
        For Each compval In Sheets("validation").Range("D2:D" & botrow)
            If compval = Y Then
                newval = compval.Offset(0, 1).Value
                ShipperComboBox.Value = newval
                Exit For
            End If
        Next

    End If
        ShipperComboBox.BackColor = rgbWhite
        ErrorLbl = ""
        ErrorLbl.BackColor = Me.BackColor
End Sub

Private Sub ShipperComboBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
       If ShipperComboBox.Value = "" Then
            ShipperComboBox.BackColor = rgbPink
            ErrorLbl = "Entry Required.  Scan barcode or enter Shipper Name"
            ErrorLbl.BackColor = rgbPink
            ShipperComboBox.SelStart = 0
            ShipperComboBox.SelLength = Len(ShipperComboBox.Value)
            Cancel = True
        End If
End Sub

Private Sub RecipientComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    x = Left(RecipientComboBox.Value, 3)
    If x = "SHP" Or x = "CAR" Or x = "RCV" Then
        RecipientComboBox.BackColor = rgbPink
        ErrorLbl = "Please Scan Correct code or enter a proper Recipient"
        ErrorLbl.BackColor = rgbPink
        RecipientComboBox.SelStart = 0
        RecipientComboBox.SelLength = Len(RecipientComboBox.Value)
        Cancel = True
    End If
End Sub

Private Sub RecipientComboBox_AfterUpdate()
    enteredvalue = Left(RecipientComboBox.Value, 3)
    If enteredvalue = "RCP" Then
        x = Me.RecipientComboBox.Value
        Y = "*" & x & "*"
        botrow = Sheets("validation").Cells(Sheets("validation").Rows.Count, 10).End(xlUp).Row
        For Each compval In Sheets("validation").Range("J2:J" & botrow)
            If compval = Y Then
                newval = compval.Offset(0, 1).Value
                RecipientComboBox.Value = newval
                Exit For
            End If
        Next

    End If
        RecipientComboBox.BackColor = rgbWhite
        ErrorLbl = ""
        ErrorLbl.BackColor = Me.BackColor
End Sub

Private Sub RecipientComboBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
       If RecipientComboBox.Value = "" Then
            RecipientComboBox.BackColor = rgbPink
            ErrorLbl = "Entry Required.  Scan barcode or enter Recipient Name"
            ErrorLbl.BackColor = rgbPink
            RecipientComboBox.SelStart = 0
            RecipientComboBox.SelLength = Len(RecipientComboBox.Value)
            Cancel = True
        End If
End Sub

Private Sub EnterButton_Click()

    Sheets("RLogData").Unprotect Password:=""
    'Application.ScreenUpdating = False
    'Sheets("RLogData").Activate
    Range("B2").End(xlDown).Offset(1, 0).Select
    ActiveCell.Offset(0, -1).Value = Application.WorksheetFunction.Max(Range("A:A")) + 1
    ActiveCell.Offset(0, 0).Value = Date
    ActiveCell.Offset(0, 1).Value = Time
    ActiveCell.Offset(0, 2).Value = CarrierComboBox
    ActiveCell.Offset(0, 3).Value = CarrierRef
    ActiveCell.Offset(0, 4).Value = ShipperComboBox
    ActiveCell.Offset(0, 5).Value = RecipientComboBox
    ActiveCell.Offset(0, 6).Value = PORef
    ActiveCell.Offset(0, 7).Value = Qty
    ActiveCell.Offset(0, 8).Value = LoginName
    Sheets("RLogData").Protect Password:="", AllowFiltering:=True
    'Sheets("Home Page").Activate
    ActiveWorkbook.Save
    'Application.ScreenUpdating = True
    CarrierComboBox.Value = ""
    CarrierRef.Value = ""
    ShipperComboBox.Value = ""
    RecipientComboBox.Value = ""
    PORef.Value = ""
    Qty.Value = 1
    CarrierComboBox.SetFocus

End Sub

Private Sub Qty_AfterUpdate()
    If Not IsNumeric(Qty.Value) Then
        MsgBox "You must enter a number", vbCritical
        Qty.SelStart = 0
        Qty.SelLength = Len(Qty.Value)
        Cancel = True
    End If
End Sub
 

Attachments

  • Screenshot 2023-02-06 092738.jpg
    Screenshot 2023-02-06 092738.jpg
    197.5 KB · Views: 4

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
I don't see the need for before update and exit events. If validation on the combo fails, why not just handle that in the before update event? IIRC, in Access you have to set focus to a control in order to deal with SelStart or SelLength. Not seeing that here so maybe in Excel it's automatic. In that case your code is probably keeping the focus on the combo and every time you try to leave it, the event fires, basically keeping you in a loop unless you close by other means as you say.

I'd move the exit code to before update or get rid of it all together and see if that fixes the issue. You can do that temporarily by commenting it out. You can also step through each procedure to see what happens which might give you some insight. That's because these 3 events work in concert: Before > After > Exit so both of the last 2 are going to happen when control data is changed. If none of that helps, you can also set a module level variable (e.g. Boolean) and set to T or F depending on your approach. You can control flow based on its value, but I consider that to be a bit of a kludge for this case.
 
Upvote 0
So I moved most of the validation to the enter key code. Everything works great now with one minor exception that I can't seem to get figured out.
If there is a non numeric entry in the Qty text box it's caught in the before update procedure. This works fine however the focus then moves from the enter button to the cancel button.
If you enter another non numeric entry the focus then moves to the logout button. This continues endlessly from Qty, enter, cancel, logout.
I've tried setting the focus (qty.setfocus) in before update within the if statement and after, also in after update.

It's not really a deal stopper but if somebody hits the enter key after correcting the mistake they could be cancelling or even logging out.

Any thoughts?

VBA Code:
Private Sub CancelButton_Click()
    CarrierComboBox.Value = ""
    CarrierRef.Value = ""
    ShipperComboBox.Value = ""
    RecipientComboBox.Value = ""
    PORef.Value = ""
    Qty.Value = 1
    CarrierComboBox.SetFocus
    
End Sub

Private Sub DataEntryFrame_Click()

End Sub

Private Sub EnterButton_Click()
    Dim ctl As MSForms.Control
    If Not everythingfilledin Then Exit Sub
    ErrorLbl = ""
    ErrorLbl.BackColor = Me.BackColor
    For Each ctl In DataEntryFrame.Controls
        ctl.BackColor = rgbWhite
    Next ctl
    Call AddDataToList
End Sub

Private Function everythingfilledin() As Boolean
    Dim ctl As MSForms.Control
    Dim anythingmissing As Boolean
    everythingfilledin = True
    anythingmissing = False
    For Each ctl In DataEntryFrame.Controls
        If ctl.Value = "" Then
            ctl.BackColor = rgbPink
            everythingfilledin = False
            ErrorLbl = "Fields cannot be blank"
            ErrorLbl.BackColor = rgbPink
            If Not anythingmissing Then ctl.SetFocus
                anythingmissing = True
                everythingfilledin = False
            
        End If
        
    Next ctl

End Function

Private Sub AddDataToList()

 Sheets("RLogData").Unprotect Password:="GregTitan"
    Range("B2").End(xlDown).Offset(1, 0).Select
    ActiveCell.Offset(0, -1).Value = Application.WorksheetFunction.Max(Range("A:A")) + 1
    ActiveCell.Offset(0, 0).Value = Date
    ActiveCell.Offset(0, 1).Value = Time
    ActiveCell.Offset(0, 2).Value = CarrierComboBox
    ActiveCell.Offset(0, 3).Value = CarrierRef
    ActiveCell.Offset(0, 4).Value = ShipperComboBox
    ActiveCell.Offset(0, 5).Value = RecipientComboBox
    ActiveCell.Offset(0, 6).Value = PORef
    ActiveCell.Offset(0, 7).Value = Qty
    ActiveCell.Offset(0, 8).Value = LoginName
    Sheets("RLogData").Protect Password:="GregTitan", AllowFiltering:=True
    ActiveWorkbook.Save
    CarrierComboBox.Value = ""
    CarrierRef.Value = ""
    ShipperComboBox.Value = ""
    RecipientComboBox.Value = ""
    PORef.Value = ""
    Qty.Value = 1
    CarrierComboBox.SetFocus
End Sub

Private Sub LogoutButton_Click()
    Unload Me
    Sheets("Home Page").Activate
End Sub


Private Sub UserForm_Activate()
    Me.StartUpPosition = 0
    Me.Top = Application.Top + 25
    Me.Left = Application.Left + Application.Width - Me.Width - 25
    Me.Height = 400
    Me.Width = 400
End Sub

Private Sub UserForm_Initialize()
    Qty.Value = 1
    Sheets("RLogData").Activate
    CarrierComboBox.SetFocus
End Sub

Private Sub CarrierComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim x As String
    x = Left(CarrierComboBox.Value, 3)
    If x = "SHP" Or x = "RCP" Or x = "RCV" Then
        CarrierComboBox.BackColor = rgbPink
        ErrorLbl = "Please Scan Correct code or enter a proper carrier"
        ErrorLbl.BackColor = rgbPink
        CarrierComboBox.SelStart = 0
        CarrierComboBox.SelLength = Len(CarrierComboBox.Value)
        Cancel = True
    End If

        
End Sub

Private Sub CarrierComboBox_AfterUpdate()

    enteredvalue = Left(CarrierComboBox.Value, 3)
    If enteredvalue = "CAR" Then
        CarrierComboBox.BackColor = Me.BackColor
        ErrorLbl = ""
        ErrorLbl.BackColor = Me.BackColor

        x = Me.CarrierComboBox.Value
        Y = "*" & x & "*"
        botrow = Sheets("validation").Cells(Sheets("validation").Rows.Count, 1).End(xlUp).Row
        For Each compval In Sheets("validation").Range("A2:A" & botrow)
            If compval = Y Then
                newval = compval.Offset(0, 1).Value
                CarrierComboBox.Value = newval
                Exit For
            End If
        Next

    End If
        If CarrierComboBox.Value <> "" Then
            CarrierComboBox.BackColor = rgbWhite
            ErrorLbl = ""
            ErrorLbl.BackColor = Me.BackColor
        End If
End Sub

Private Sub ShipperComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    x = Left(ShipperComboBox.Value, 3)
    If x = "CAR" Or x = "RCP" Or x = "RCV" Then
        ShipperComboBox.BackColor = rgbPink
        ErrorLbl = "Please Scan Correct code or enter a proper Shipper"
        ErrorLbl.BackColor = rgbPink
        ShipperComboBox.SelStart = 0
        ShipperComboBox.SelLength = Len(ShipperComboBox.Value)
        Cancel = True
    End If

End Sub

Private Sub ShipperComboBox_AfterUpdate()
    enteredvalue = Left(ShipperComboBox.Value, 3)
    If enteredvalue = "ShP" Then
        ShipperComboBox.BackColor = Me.BackColor
        ErrorLbl = ""
        ErrorLbl.BackColor = Me.BackColor
        
        x = Me.ShipperComboBox.Value
        Y = "*" & x & "*"
        botrow = Sheets("validation").Cells(Sheets("validation").Rows.Count, 4).End(xlUp).Row
        For Each compval In Sheets("validation").Range("D2:D" & botrow)
            If compval = Y Then
                newval = compval.Offset(0, 1).Value
                ShipperComboBox.Value = newval
                Exit For
            End If
        Next

    End If
        ShipperComboBox.BackColor = rgbWhite
        ErrorLbl = ""
        ErrorLbl.BackColor = Me.BackColor
End Sub

Private Sub RecipientComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    x = Left(RecipientComboBox.Value, 3)
    If x = "SHP" Or x = "CAR" Or x = "RCV" Then
        RecipientComboBox.BackColor = rgbPink
        ErrorLbl = "Please Scan Correct code or enter a proper Recipient"
        ErrorLbl.BackColor = rgbPink
        RecipientComboBox.SelStart = 0
        RecipientComboBox.SelLength = Len(RecipientComboBox.Value)
        Cancel = True
    End If
End Sub

Private Sub RecipientComboBox_AfterUpdate()
    enteredvalue = Left(RecipientComboBox.Value, 3)
    If enteredvalue = "RCP" Then
        x = Me.RecipientComboBox.Value
        Y = "*" & x & "*"
        botrow = Sheets("validation").Cells(Sheets("validation").Rows.Count, 10).End(xlUp).Row
        For Each compval In Sheets("validation").Range("J2:J" & botrow)
            If compval = Y Then
                newval = compval.Offset(0, 1).Value
                RecipientComboBox.Value = newval
                Exit For
            End If
        Next

    End If
        RecipientComboBox.BackColor = rgbWhite
        ErrorLbl = ""
        ErrorLbl.BackColor = Me.BackColor
End Sub

Private Sub Qty_Beforeupdate(ByVal Cancel As MSForms.ReturnBoolean)
    If Not IsNumeric(Qty) Then
        Qty.BackColor = rgbPink
        ErrorLbl = "Qty must contain a positive number"
        ErrorLbl.BackColor = rgbPink
        Qty.SelStart = 0
        Qty.SelLength = Len(Qty.Value)
        Cancel = True
        
    End If
        
End Sub

Private Sub Qty_AfterUpdate()
        
        Qty.BackColor = rgbWhite
        ErrorLbl = ""
        ErrorLbl.BackColor = Me.BackColor
End Sub
 
Upvote 0
I should also mention that most of the entries will be handled by a "Barcode Cheat Sheet" so little to no keyboard entry is required.
That would explain some of the strange validation code you see verifying to make sure the wrong barcode is not scanned.
The final "ENTER" button would be triggered by the scanner as well.
 
Upvote 0
There are 2 vba numeric functions - IsNumeric and IsNumber. Former returns true if the value can be converted to a number, and that includes empty strings. IsNumber tests if the value is a number, so I'd suggest adding that test. Question is, does this apply to more than one control? If so, consider writing that as a separate function that you call for those controls only.
So maybe after If Not everythingfilledin Then Exit Sub
put
If Not IsNumber(qty) Then Exit Sub

Why have 2 booleans that are for the same thing? If something is missing, it stands to reason that not everything is filled in? Perhaps I'm not interpreting the code correctly. Also, a boolean is false by default so you don't need to set it to false to begin with.
 
Upvote 0
Thanks Micron,
I'll give the Isnumber thing a try. Hopefully that should break the routine that passes the focus.
The purpose of the two booleans in the function is that the first one hightlights all the textboxes that don't have information and the second one is for setting the focus to the first one in the list that isn't filled in. May not necessarily be needed but wanted to make the form as idiot proof as possible. Entry could be done by any number of warehouse staff that could really care less if the information was entered or not.
As you can tell I'm an amateur at programming. Because I only delve into it to make my spreadsheets function better for my job I don't get a whole lot of practice. It doesn't help that I may get something working and then not have the need to program again for months or years. So everything I learned to get one spreadsheet working has been forgotten by the time I have to make another one work. lol frustrating to say the least. Not much like riding a bike. haha
I do appreciate your help and suggestions.
 
Upvote 0

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,094
Latest member
teemeren

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