UserForm Data Validation

[reberryjr]

I have a UserForm that has 43 text and combo boxes. I want to introduce some code that verifies that certain fields are completed, and in certain formats. An example is "txt_Updated". This field is required to be completed. I added the code below, but want the User to be able to either enter MM/DD/YY, MM/D/YY, M/D/YY, M/DD/YY, depending upon the actual date. In essence, I'm really just trying to ensure that the text box isn't null, text or some weird entry like 123/1/17, when it should be 12/31/17.

The other thing that I'd like to do is have all of this validation take place prior to the code starting to enter data into the various worksheets, so that I don't wind up with partial data entry.

Do I have to add all of this validation before the code starts, or is there a way to validate as the code runs, and if a rule is not met, have the data entry not occur? I'm trying to keep the code as clean as possible and it feels as though it's starting to get a bit messy.

I've only included some of the code below, as it's pretty long and I'm hoping to extrapolate the response I receive here, to the rest of the code. Specific questions/examples are in red font.

Private Sub cmd_Submit_Click()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet


Dim NextRow As Long
Dim NextRow2 As Long
Dim NextRow3 As Long


Set ws1 = ThisWorkbook.Sheets("Bios")
Set ws2 = ThisWorkbook.Sheets("Stats")
Set ws3 = ThisWorkbook.Sheets("Financials")
Set ws4 = ThisWorkbook.Sheets("Variables")


NextRow = ws1.Range("D" & Rows.Count).End(xlUp).Row + 1
NextRow2 = ws2.Range("C" & Rows.Count).End(xlUp).Row + 1
NextRow3 = ws3.Range("D" & Rows.Count).End(xlUp).Row + 1


[COLOR=#ff0000]'Can I add this type of code to the executing line, so that I can add a more descriptive message box, or do I HAVE to do the validation before the code starts to run?[/COLOR]
If Me.txt_Height.Value = "" Or Me.txt_Weight.Value = "" Or Me.txt_Chest.Value = "" Or Me.txt_Waist.Value = "" Or Me.txt_Hips.Value = "" Then
    MsgBox "Please verify that you have entered a value for Height, Weight, Chest, Waist and Hips."
Else


ws1.Range("A" & NextRow).Value = "=Today()"
[COLOR=#ff0000]'Here is the code validating the Updated date, mentioned in the post.[/COLOR]
If Not Me.txt_Updated.Value Like "##[/]##[/]##" Then
    MsgBox "Please enter a valid date."
Else
ws1.Range("B" & NextRow).Value = CDate(Me.txt_Updated) 'This should be the date that the Client provided the updated figures.
End If
ws1.Range("C" & NextRow).Value = "Active"
ws1.Range("D" & NextRow).Value = CInt(Me.txt_Key)
With ws1.Range("E" & NextRow)
    .Hyperlinks.Add _
    anchor:=.Offset(), _
    Address:="", _
    SubAddress:="'" & Me.txt_ClientID.Value & "'!AW1", _
    TextToDisplay:=Me.txt_ClientID.Value
End With
ws1.Range("F" & NextRow).Value = Me.txt_First
ws1.Range("G" & NextRow).Value = Me.txt_Last
ws1.Range("H" & NextRow).Value = Me.txt_Suff
ws1.Range("I" & NextRow).Value = Me.txt_Name
ws1.Range("J" & NextRow).Value = Me.cobo_Gender
ws1.Range("K" & NextRow).Value = CDate(Me.txt_DoB)
ws1.Range("L" & NextRow).Value = CInt(Me.txt_SignupAge)
ws1.Range("M" & NextRow).Value = "=IF(RC[-2]="""","""",INT(RC[-12]-RC[-2])/365.25)"
ws1.Range("N" & NextRow).Value = (Me.txt_Phone)
With ws1.Range("O" & NextRow)
    .Hyperlinks.Add _
    anchor:=.Offset(), _
    Address:="mailto:" & Me.txt_Email.Value, _
    TextToDisplay:=Me.txt_Email.Value
End With


ws2.Range("A" & NextRow2).Value = "=Today()"
ws2.Range("B" & NextRow2).Value = CDate(Me.txt_Updated)
ws2.Range("C" & NextRow2).Value = Me.txt_ClientID
ws2.Range("D" & NextRow2).Value = Me.txt_Name
ws2.Range("E" & NextRow2).Value = "Initial"
ws2.Range("F" & NextRow2).Value = Me.txt_Height
[COLOR=#FF0000]'Can I add validation in this line that ensures the value entered is numeric and if it isn't, prevents any of the code from executing?[/COLOR]
ws2.Range("G" & NextRow2).Value = CStr(Me.txt_Weight)

I've been working on this for a few hours and am unsure about the best way to structure the code.

 

[Fluff]

If you want to ensure you don't have partial data entry, then all validations need to go at the start of the code.
you can check for dates like

If Not IsDate(TextBox1) Then
   MsgBox "not a date"
   Exit Sub
End If

but this will accept both 12/31/17 and 31/12/17 as both are valid dates.
You can check for a number using

IsNumeric

but there are pitfalls with it.(I'll see if I can find the relevant thread)

 

[Fluff]

Here's the link regarding using Isnumeric
http://www.excelfox.com/forum/showt...sing-VBA-s-IsNumeric-Function-Read-this-first

 

[reberryjr]

WOW! Ok, that's been bookmarked. LOL!

 

[reberryjr]

I'm confused. I have the validation to check for a valid DoB before the code runs, but when I click the Submit cmd button without a date in the DoB text box, a message box doesn't pop up. One does for the absence of the First Name, but when I click OK, the code gets an error. Do I not have it structured, so that it basically checks all fields before actually updating the spreadsheet?

Private Sub cmd_Submit_Click()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet


Dim NextRow1 As Long
Dim NextRow2 As Long
Dim NextRow3 As Long
Dim NextRow4 As Long


Set ws1 = ThisWorkbook.Sheets("Bios")
Set ws2 = ThisWorkbook.Sheets("Stats")
Set ws3 = ThisWorkbook.Sheets("Financials")


NextRow1 = ws1.Range("D" & Rows.Count).End(xlUp).Row + 1
NextRow2 = ws2.Range("B" & Rows.Count).End(xlUp).Row + 1
NextRow3 = ws3.Range("D" & Rows.Count).End(xlUp).Row + 1


If Me.txt_First.Value = "" Then
    MsgBox "Please enter a First name."
    If response = vbOK Then
        frm_AddNew.Show
    End If
Else
If Me.txt_Last = "" Then
    MsgBox "Please enter a Last name."
Else
If Me.cobo_Gender = "" Then
    MsgBox "Please enter a Gender."
Else
If Me.txt_Email = "" Then
    MsgBox "Please enter a valid Email Address."
Else
If Me.txt_Height = "" Then
    MsgBox "Please enter a valid Height measurement."
Else
If Not IsDate(Me.txt_Updated) Then
    MsgBox "Please enter a valid Updated date in MM/DD/YY format."
Else
If Not IsDate(Me.txt_DoB) Then
    MsgBox "Please enter a valid Date of Birth in MM/DD/YY format."
Else
If Not IsNumeric(Me.txt_SignupAge) Or Len(Me.txt_SignupAge.Value) <> 2 Then
    MsgBox "Please enter a valid Signup Age."
Else
If Not IsNumeric(Me.txt_Phone) Or Len(Me.txt_Phone.Value) <> 10 Then
    MsgBox "Please enter a valid Phone Number."
Else
If Not IsNumeric(Me.txt_Weight) Then
    MsgBox "Please enter a valid Weight measurement."
Else
If Not IsNumeric(Me.txt_Chest) Then
    MsgBox "Please enter a valid Chest measurement."
Else
If Not IsNumeric(Me.txt_Waist) Then
    MsgBox "Please enter a valid Waist measurement."
Else
If Not IsNumeric(Me.txt_Hips) Then
    MsgBox "Please enter a valid Hips measurement."
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If


ws1.Range("A" & NextRow1).Value = "=Today()"
ws1.Range("B" & NextRow1).Value = CDate(Me.txt_Updated)
ws1.Range("C" & NextRow1).Value = "Active"
ws1.Range("D" & NextRow1).Value = CInt(Me.txt_Key)
'With ws1.Range("E" & NextRow1)
    '.Hyperlinks.Add _
    'Anchor:=.Offset(), _
    'Address:="", _
    'SubAddress:="'" & Me.txt_ClientID.Value & "'!AW1", _
    'TextToDisplay:=Me.txt_ClientID.Value
'End With
ws1.Range("F" & NextRow1).Value = Me.txt_First
ws1.Range("G" & NextRow1).Value = Me.txt_Last
ws1.Range("H" & NextRow1).Value = Me.txt_Suff
ws1.Range("I" & NextRow1).Value = Me.txt_Name
ws1.Range("J" & NextRow1).Value = Me.cobo_Gender
ws1.Range("K" & NextRow1).Value = CDate(Me.txt_DoB)
ws1.Range("L" & NextRow1).Value = CInt(Me.txt_SignupAge)
ws1.Range("M" & NextRow1).Value = "=IF(RC[-2]="""","""",INT(RC[-12]-RC[-2])/365.25)"
ws1.Range("N" & NextRow1).Value = (Me.txt_Phone)
With ws1.Range("O" & NextRow1)
    .Hyperlinks.Add _
    anchor:=.Offset(), _
    Address:="mailto:" & Me.txt_Email.Value, _
    TextToDisplay:=Me.txt_Email.Value
End With


End Sub

 

[Fluff]

Do I not have it structured, so that it basically checks all fields before actually updating the spreadsheet?

No. You have a load of nested If statements, rather than separate ones. To see what is happening put a break point on the 1st if statement, then enter open the form & click submit. The code will run to the break point & then stop, at wich point you can step through the code line by line by using the F8 key.
One option is to replace all the Else with End If, or another way is to use a Select Case statement like

Dim IsOk As Boolean
IsOk = True
Select Case True
   Case Me.tb1.Value = ""
      MsgBox "Please enter a First name."
      If response = vbOK Then
          frm_AddNew.Show
      End If
      IsOk = False
   Case Me.tb2 = ""
       MsgBox "Please enter a Last name."
       IsOk = False
   Case Me.tb3 = ""
         MsgBox "Please enter a Gender."
         IsOk = False
   Case Me.tb4 = ""
       MsgBox "Please enter a valid Email Address."
       IsOk = False
End Select

 

[reberryjr]

Ok, so I utilized a combination of the IF and Case statements in different spots. Everything seems to be working, but I'm not able to get the cursor to pop back into a specific text box. After some research, I found the .SetFocus method. I tossed it into the code as follows, but it still doesn't seem to be working. Do I have the syntax incorrect?

In the same piece of code, I'm getting a message box, but shouldn't be. I've entered a date in the DPStart and DP1stPymt boxes, an amount in the DPPymtAmt and a value in the DPFreq box. I'm unsure why a message box is firing off.

    If Me.txt_DPStart <> 0 Or Me.txt_DP1stPymt <> 0 Or Me.txt_DPPymtAmt > 0 Or Me.cobo_DPFreq <> 0 Or Me.txt_DPPaid > 0 And _        Me.txt_DPStart = 0 Or Me.txt_DP1stPymt = 0 Or Me.txt_DPPymtAmt = 0 Or Me.cobo_DPFreq = 0 Then
            MsgBox "Please verify the Client's Diet Plan information."
            If response = vbOK Then
                txt_DPStart.SetFocus
            End If
            Exit Sub

Any thoughts?

 

[reberryjr]

I think I fixed the message box issue with this code, but I'm still not able to get the cursor into the specific text box.

    If IsEmpty(Me.txt_DPStart) Or IsEmpty(Me.txt_DP1stPymt) Or IsEmpty(Me.txt_DPPymtAmt) Or IsEmpty(Me.cobo_DPFreq) Or Me.txt_DPPaid > 0 And _        IsEmpty(Me.txt_DPStart) Or IsEmpty(Me.txt_DP1stPymt) Or IsEmpty(Me.txt_DPPymtAmt) Or IsEmpty(Me.cobo_DPFreq) Then
            MsgBox "Please verify the Client's Diet Plan information."
            If response = vbOK Then
                txt_DPStart.SetFocus
            End If
            Exit Sub
    End If

 

[dmt32]

I think I fixed the message box issue with this code, but I'm still not able to get the cursor into the specific text box.

rather than hard code each of the required controls in your form - consider creating a couple of functions to mange this all in one place.

Not fully tested but see if you can work the following in to your project


Place both codes in a STANDARD module

Data Entry Validate Function

Function IsValidData(ByVal Form As Object) As Boolean
    Dim ControlName() As String
    Dim DataType As Variant, DateFormat As Variant
    Dim arr As Variant
    Dim i As Integer
    
'get controls array
    arr = RequiredControls


'loop each control
    For i = LBound(arr) To UBound(arr)
'split control name, msg prompt & data type
        ControlName = Split(arr(i), ",")
        
'change the string name of the data type constant taken from array, to its integer value
        DataType = IIf(ControlName(2) = "xlDate", xlDate, IIf(ControlName(2) = "xlNumber", xlNumber, xlText))
        
'validate data entry
        With Form.Controls(ControlName(0))
        
        Select Case CLng(DataType)
        
        Case xlNumber
        IsValidData = CBool(IsNumeric(.Text))
        'apply other tests here as required
        
        Case xlDate
        IsValidData = CBool(IsDate(.Text))
        
'check valid date format
       If IsValidData Then
        For Each DateFormat In Array("##/##/##", "##/#/##", "#/#/##", "#/##/##")
            IsValidData = CBool(.Text Like DateFormat)
            If IsValidData Then Exit For
        Next DateFormat
        End If
        
        'apply other tests here as required
        
        Case xlText
        IsValidData = CBool(Len(.Text) > 0)
        'apply other tests here as required
        
        End Select


'inform user & exit function
        If Not IsValidData Then .SetFocus: MsgBox ControlName(1), 48, "Entry Required": Exit Function
        End With
    Next i
 End Function

I have added additional test to validate required date format but you can develop other tests for other data types as required.

Control Names Function with error message & data type

Function RequiredControls() As Variant
'control name , error msg prompt & required data type of each control
RequiredControls = Array("txt_First,Please enter a First name.,xlText", _
                    "txt_Last,Please enter a Last name.,xlText", _
                    "cobo_Gender,Please enter a Gender.,xlText", _
                    "txt_Email,Please enter a valid Email Address.,xlText", _
                    "txt_Height,Please enter a valid Height measurement.,xlNumber", _
                    "txt_Updated,Please enter a valid Updated date in MM/DD/YY format.,xlDate", _
                    "txt_DoB,Please enter a valid Date of Birth in MM/DD/YY format.,xlDate", _
                    "txt_SignupAge,Please enter a valid Signup Age.,xlNumber", _
                    "txt_Phone,Please enter a valid Phone Number.,xlNumber", _
                    "txt_Weight,Please enter a valid Weight measurement.,xlNumber", _
                    "txt_Chest,Please enter a valid Chest measurement.,xlNumber", _
                    "txt_Waist,Please enter a valid Waist measurement.,xlNumber", _
                    "txt_Hips,Please enter a valid Hips measurement.,xlNumber")
End Function

I have only added controls you published - you will need to add to Function as required


To call Function add this line at top of your commandbutton code

Private Sub CommandButton1_Click()
    If Not IsValidData(Me) Then Exit Sub
    
    'rest of your code
End Sub

Personally for a userform with so many textboxes I would create a table in a worksheet & read all required attributes from that but hopefully, suggestion here will give you something to play with.


Dave

 

[reberryjr]

@dmt32 Thanks for the feedback! I like the suggestion a lot! Some of these terms are new to me, so after I do some research, I'll put something together and test it out.