problem with: Data validation in user form

mahhdy

Board Regular
Joined
Sep 15, 2016
Messages
86
Hi guys,
I have a userform for entering the receiving data by the storekeepers, I want to set some mandatory fields for filling in. They are the username, part number and stored location of received file.
I am using the data of my "ref" worksheet for adding items to my combo boxes. and I forced combo box to don't accept any item out of that list. (by using field property "matchrequired" to true).
I have 4 command buttons, done for saving and closing, "add item" for adding a new item to current release note, new release note, which clear the R/N data and would ask for it again, and finally close, which closes the form.
My question is how can I force VBA to check is there any data in the "USER", "P/N" and "Location", and if at least these three field have data, then data entry be possible.
I also want to the code to be able for checking the entry of QTY field and just accepts number (between 1 and 5000 for instance).
Everything is ok with DONE button, but for the two ("add item" and "new release note") stupid errors returns. after msg box showing up the data clears, the combo's items will lost or returns error and so...

I am using "addcmbo" for adding items to combo controls. (Just for user when I am putting that here, the value duplicates in the combo index, and also after message box, the items of this control remains).

If you find any "not good practice" approaches, let me know please.

userform.jpg


Code:
Sub addcmbo()
Application.ScreenUpdating = False
                Sheet2.Activate
            ' A/C data update
                For i = 2 To WorksheetFunction.CountA(Range("b:b"))
                    If Sheets("Ref").Cells(i, 2) <> "" Then
                        RCVNG.cmbac.AddItem (Cells(i, 2))
                    End If
                Next
            ' W/B data update
                For i = 2 To WorksheetFunction.CountA(Range("h:h"))
                    If Sheets("Ref").Cells(i, 8) <> "" Then
                        RCVNG.Cmbwb.AddItem (Cells(i, 8))
                    End If
                Next
            ' w/C data update
                For i = 2 To WorksheetFunction.CountA(Range("i:i"))
                    If Sheets("Ref").Cells(i, 9) <> "" Then
                        RCVNG.Cmbwc.AddItem (Cells(i, 9))
                    End If
                Next
            ' P/# data update
                For i = 2 To WorksheetFunction.CountA(Range("j:j"))
                    If Sheets("Ref").Cells(i, 10) <> "" Then
                        RCVNG.Cmbpn.AddItem (Cells(i, 10))
                    End If
                Next
                    Sheet1.Activate
                    Application.ScreenUpdating = True
End Sub
Private Sub btnCncl_Click()
    Unload Me
End Sub

Private Sub btnadditem_Click()

'    Form fields Clear
        cmbac.Clear
        Cmbwb.Clear
        Cmbwc.Clear
        Cmbpn.Clear
'        cmbac.Value = ""
'        Cmbwb.Value = ""
'        Cmbwc.Value = ""
'        Cmbpn.Value = ""
        Txtqty.Value = ""
        txtSN.Value = ""
        Txtloc.Value = ""
        cmnt.Value = ""
        
'    Data entry sufficiency check
    If cmbuser = "" Or Cmbpn = "" Or Txtloc = "" Then
        MsgBox "Please Fill Required Fields " & Chr(10) & "   *  User" & Chr(10) & "   *  Part #" & Chr(10) & "   *  Location" & Chr(10) & " before Save!"
        Call addcmbo
    Else:
'    Data Entry
    Sheet1.Activate
    Dim oNewRow As ListRow
        ActiveSheet.Cells(1, 3).Select
        Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
        oNewRow.Range.Cells(1, 6).Value = DTPicker.Value
        oNewRow.Range.Cells(1, 7).Value = txtrn.Value
        oNewRow.Range.Cells(1, 14).Value = cmbuser.Value
        oNewRow.Range.Cells(1, 8).Value = cmbac.Value
        oNewRow.Range.Cells(1, 10).Value = Cmbwb.Value
        oNewRow.Range.Cells(1, 9).Value = Cmbwc.Value
        oNewRow.Range.Cells(1, 11).Value = Cmbpn.Value
        oNewRow.Range.Cells(1, 12).Value = Txtqty.Value
        oNewRow.Range.Cells(1, 13).Value = txtSN.Value
        oNewRow.Range.Cells(1, 15).Value = Txtloc.Value
        oNewRow.Range.Cells(1, 16).Value = cmnt.Value
    End If
End Sub

Private Sub btndone_Click()
'    Data entry sufficiency check
    If cmbuser = "" Or Cmbpn = "" Or Txtloc = "" Then
        MsgBox "Please Fill Required Fields " & Chr(10) & "   *  User" & Chr(10) & "   *  Part #" & Chr(10) & "   *  Location" & Chr(10) & " before Save!"
    Else:
'    Data Entry
    Sheet1.Activate
        ActiveSheet.Cells(1, 3).Select
        Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
        oNewRow.Range.Cells(1, 6).Value = DTPicker.Value
        oNewRow.Range.Cells(1, 7).Value = txtrn.Value
        oNewRow.Range.Cells(1, 14).Value = cmbuser.Value
        oNewRow.Range.Cells(1, 8).Value = cmbac.Value
        oNewRow.Range.Cells(1, 10).Value = Cmbwb.Value
        oNewRow.Range.Cells(1, 9).Value = Cmbwc.Value
        oNewRow.Range.Cells(1, 11).Value = Cmbpn.Value
        oNewRow.Range.Cells(1, 12).Value = Txtqty.Value
        oNewRow.Range.Cells(1, 13).Value = txtSN.Value
        oNewRow.Range.Cells(1, 15).Value = Txtloc.Value
        oNewRow.Range.Cells(1, 16).Value = cmnt.Value
    Unload Me
    End If

End Sub

Private Sub btnnewrn_Click()
Dim oNewRow As ListRow
'    Form fields Clear
        txtrn.Value = ""
        cmbac.Clear
        Cmbwb.Clear
        Cmbwc.Clear
        Cmbpn.Clear
        cmbac.Value = ""
        Cmbwb.Value = ""
        Cmbwc.Value = ""
        Cmbpn.Value = ""
        Txtqty.Value = ""
        txtSN.Value = ""
        Txtloc.Value = ""
        cmnt.Value = ""
        
'    Data entry sufficiency check
    If cmbuser = "" Or Cmbpn = "" Or Txtloc = "" Then
        MsgBox "Please Fill Required Fields " & Chr(10) & "   *  User" & Chr(10) & "   *  Part #" & Chr(10) & "   *  Location" & Chr(10) & " before Save!"
        Call addcmbo
    Else:
'    Data Entry
    Sheet1.Activate
        ActiveSheet.Cells(1, 3).Select
        Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
        oNewRow.Range.Cells(1, 6).Value = DTPicker.Value
        oNewRow.Range.Cells(1, 7).Value = txtrn.Value
        oNewRow.Range.Cells(1, 14).Value = cmbuser.Value
        oNewRow.Range.Cells(1, 8).Value = cmbac.Value
        oNewRow.Range.Cells(1, 10).Value = Cmbwb.Value
        oNewRow.Range.Cells(1, 9).Value = Cmbwc.Value
        oNewRow.Range.Cells(1, 11).Value = Cmbpn.Value
        oNewRow.Range.Cells(1, 12).Value = Txtqty.Value
        oNewRow.Range.Cells(1, 13).Value = txtSN.Value
        oNewRow.Range.Cells(1, 15).Value = Txtloc.Value
        oNewRow.Range.Cells(1, 16).Value = cmnt.Value
    End If
End Sub

Private Sub lblpn_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim pn As String
    Application.ScreenUpdating = False
    Sheet2.Activate
    emptyRow = WorksheetFunction.CountA(Range("j:j")) + 1
    pn = inputbox("Type In new ''P/#'' please", "Add NEW P/#")
        Cells(emptyRow, 10).Value = pn
        RCVNG.Cmbpn.AddItem pn
End Sub

Private Sub lblTeam_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim t As String
    Application.ScreenUpdating = False
    Sheet2.Activate
    emptyRow = WorksheetFunction.CountA(Range("c:c")) + 1
    t = inputbox("Type type Your Name Please", "Add name of NEW or Missing team member")
        Cells(emptyRow, 3).Value = t
        RCVNG.cmbuser.AddItem t
End Sub


Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
    Sheet2.Activate
    DTPicker.SetFocus
    DTPicker.Value = Date
'empty fields
    shipreceive.Value = ""
    txtrn.Value = ""
    cmbuser.Clear
    cmbac.Clear
    Cmbwb.Clear
    Cmbwc.Clear
    Cmbpn.Clear
    Txtqty.Value = ""
    txtSN.Value = ""
    Txtloc.Value = ""
    cmnt.Value = ""
' Combo fields add item
    Call addcmbo
' User data update
    Application.ScreenUpdating = False
    Sheet2.Activate
    For i = 2 To WorksheetFunction.CountA(Range("c:c"))
        If Sheets("Ref").Cells(i, 3) <> "" Then
            RCVNG.cmbuser.AddItem (Cells(i, 3))
        End If
    Next
    Sheet1.Activate
    Application.ScreenUpdating = True
End Sub
Thanks a lot, I will appreciate your help
 
Last edited:

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
for the record and putting this item away from zero replied posts.

The exact problem was the sequence of code. I was first asking to clear the fields and then checking their content. So is so stupid.
Just with putting the clear codes to the end of button command. it fixed.
Yours,
M
 
Upvote 0

Forum statistics

Threads
1,223,703
Messages
6,173,973
Members
452,540
Latest member
haasro02

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