Need help with VBA date validation

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
Hello forum friends,

I could sure use some suggestions on how to best force my users to enter a valid date in a 'Date of Birth' field on a UserForm before they click the OK button. The code sends the date to Sheet11 (E9) and while it rejects some input, it accepts other input which creates a problem on Sheet11 (E9) where cell E9 is formatted as DATE.

In the examples below, the output to cell E9 should be 12/4/1966. In fact, it NEEDS to be 12/4/1966.
So, if the input is:

4/12/66 - accepted - output= 12/4/1966
4 12 66 - accepted - output= 4 12 66 (should be rejected)
4-12-66 - accepted - output= 12/4/1966
april 12 66 - accepted - output= april 12 66 (should be rejected)
april 12 1966 - accepted - output= april 12 1966 (should be rejected)
april 12, 1966 - accepted - output= 12/4/1966
1966/4/12 - accepted - output= 12/4/1966
apr 12, 1966 - accepted - output= 12/4/1966
ap 12, 1966 - rejected - output= MsgBox
1966 April 12 - accepted - output= 1966 April 12 (should be rejected)

There may be lots of others but you can see that there are many instances where the input should be rejected and the MsgBox should pop up advising the user to "Please enter a valid date!" but it is oftentimes accepting this input instead of rejecting it. This is what I am hoping to find a way to correct. I appreciate any ideas. Thanks!

VBA Code:
Private Sub OKCommandButton_Click()

    If UCase(Me.GenderComboBox.Text) = "M" Or UCase(Me.GenderComboBox.Text) = "F" Then

    Else
        MsgBox "Please select M or F from the list."
    Exit Sub
    End If
    
    If IsDate(Me.DOBTextBox.Text) = False Then
        MsgBox "Please enter a valid date!"
        Exit Sub
    End If
    
    With Sheets(11)

        If Not AllmostEmpty(FirstNameTextBox) Then .Range("C9").Value = FirstNameTextBox.Value
        If Not AllmostEmpty(FirstNameTextBox) Then .Range("B15").Value = FirstNameTextBox.Value
        If LastNameTextBox <> "Optional" Then
            If Not AllmostEmpty(LastNameTextBox) Then .Range("D9").Value = LastNameTextBox.Value
        End If
        If DOBTextBox.Text <> "Use long date i.e. May 6, 1951" Then
           If Not AllmostEmpty(DOBTextBox) Then .Range("E9").Value = DOBTextBox.Value
        End If
        If Not AllmostEmpty(GenderComboBox) Then .Range("F9").Value = GenderComboBox.Value
    End With
Unload Me
End Sub
 

Some videos you may like

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
@silentwolf I saw that video and even tried to incorporate his ideas in my code but it still accepts far too many inputs than it should. I would like my userform to reject anything that isn't a valid date.
VBA Code:
If IsDate(Me.DOBTextBox.Text) = False Then
        MsgBox "Please enter a valid date!"
        Exit Sub
    End If
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,961
Office Version
  1. 365
Platform
  1. Windows
Hi, @leopardhawk
I think you should validate the date & convert it to the accepted format when the focus exits the textbox.

VBA Code:
Private Sub Me.DOBTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With Me.DOBTextBox
    If IsDate(.Value) Then
        .Value = Format(.Value, "m/d/yyyy")
    Else
        MsgBox "Please enter a valid date, such as: 4-15-20 (month-day-year)"
        Cancel = True
        .Value = Empty
    End If
End With
End Sub

Edited: I changed "Me.DOBTextBox.Text" to "Me.DOBTextBox"
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

@Akuini I'm confused. I assume you saw my original post with my code. I am trying to put this on a UserForm and there is already a Private Sub. When I try and add your code, I am getting errors. Sorry.
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,961
Office Version
  1. 365
Platform
  1. Windows
Do you mean you already have "Private Sub Me.DOBTextBox_Exit"? If not then it should be ok, because what you have is "Private Sub OKCommandButton_Click()".
Did you read that I've edited the code in post #4? The textbox for the date is "Me.DOBTextBox", isn't it?
What error did you get?
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

@Akuini as soon as I paste your code into the code for my Command button, the first line of your code turns red. When I execute, the Userform comes up but I am getting a syntax error when I enter a date and hit the OK button. To be clear, I'm supposed to replace the "If IsDate" part of my code (which also starts with "Private Sub") with your code as-is..??
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,961
Office Version
  1. 365
Platform
  1. Windows
To be clear, I'm supposed to replace the "If IsDate" part of my code (which also starts with "Private Sub") with your code as-is..??
No, it's a different Sub.
Don't change your code, just put my code below your code. So put it below "End Sub" of your code.
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
@Akuini ok, I did as instructed, from a clean, working test version of my workbook, I copied and pasted your code directly below the "End Sub" of the "Private Sub OKCommandButton_Click()". Then I ran the code, entered a valid date in the DOB field and hit OK, getting the same compile/syntax error. The first line of your code is still red when I paste it in. My whole code is below:
VBA Code:
Private Sub OKCommandButton_Click()

    If UCase(Me.GenderComboBox.Text) = "M" Or UCase(Me.GenderComboBox.Text) = "F" Then

    Else
        MsgBox "Please select M or F from the list."
    Exit Sub
    End If
   
    If IsDate(Me.DOBTextBox.Text) = False Then
        MsgBox "Please enter a valid date!"
        Exit Sub
    End If
   
    With Sheets(11)

        .Unprotect Password:="passwordhere"
        If Not AllmostEmpty(FirstNameTextBox) Then .Range("C9").Value = FirstNameTextBox.Value
        If Not AllmostEmpty(FirstNameTextBox) Then .Range("B15").Value = FirstNameTextBox.Value
        If LastNameTextBox <> "Optional" Then
            If Not AllmostEmpty(LastNameTextBox) Then .Range("D9").Value = LastNameTextBox.Value
        End If
        If DOBTextBox.Text <> "Use long date i.e. May 6, 1951" Then
           If Not AllmostEmpty(DOBTextBox) Then .Range("E9").Value = DOBTextBox.Value
        End If
        If Not AllmostEmpty(GenderComboBox) Then .Range("F9").Value = GenderComboBox.Value
        If CompanyTextBox <> "Optional" Then
        If Not AllmostEmpty(CompanyTextBox) Then .Range("G9").Value = CompanyTextBox.Value
        End If
        If RDTextBox.Text <> "Use long date format" Then
            If Not AllmostEmpty(RDTextBox) Then .Range("C15").Value = RDTextBox.Value
        End If
        If Not AllmostEmpty(OptionComboBox) Then .Range("D15").Value = OptionComboBox.Value
        If Not AllmostEmpty(ProviderComboBox) Then .Range("E15").Value = ProviderComboBox.Value
        If CPPTextBox.Text <> "Use long date format" Then
        If Not AllmostEmpty(CPPTextBox) Then .Range("F15").Value = CPPTextBox.Value
        End If
        If OASTextBox.Text <> "Use long date format" Then
        If Not AllmostEmpty(OASTextBox) Then .Range("G15").Value = OASTextBox.Value
        End If
        .Protect Password:="passwordhere"
    End With
       
    With Sheets(11)

        .Unprotect Password:="passwordhere"
        If Not AllmostEmpty(SFirstNameTextBox) Then .Range("C11").Value = SFirstNameTextBox.Value
        If Not AllmostEmpty(SFirstNameTextBox) Then .Range("B17").Value = SFirstNameTextBox.Value
        If SLastNameTextBox <> "Optional" Then
            If Not AllmostEmpty(SLastNameTextBox) Then .Range("D11").Value = SLastNameTextBox.Value
        End If
        If SDOBTextBox.Text <> "Use long date i.e. May 6, 1951" Then
           If Not AllmostEmpty(SDOBTextBox) Then .Range("E11").Value = SDOBTextBox.Value
        End If
        If Not AllmostEmpty(SGenderComboBox) Then .Range("F11").Value = SGenderComboBox.Value
        If SCompanyTextBox <> "Optional" Then
        If Not AllmostEmpty(SCompanyTextBox) Then .Range("G11").Value = SCompanyTextBox.Value
        End If
        If SRDTextBox.Text <> "Use long date format" Then
            If Not AllmostEmpty(SRDTextBox) Then .Range("C17").Value = SRDTextBox.Value
        End If
        If Not AllmostEmpty(SOptionComboBox) Then .Range("D17").Value = SOptionComboBox.Value
        If Not AllmostEmpty(SProviderComboBox) Then .Range("E17").Value = SProviderComboBox.Value
        If SCPPTextBox.Text <> "Use long date format" Then
        If Not AllmostEmpty(SCPPTextBox) Then .Range("F17").Value = SCPPTextBox.Value
        End If
        If SOASTextBox.Text <> "Use long date format" Then
        If Not AllmostEmpty(SOASTextBox) Then .Range("G17").Value = SOASTextBox.Value
        End If
        .Protect Password:="passwordhere"
    End With
   
Unload Me
   
End Sub

Private Sub Me.DOBTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With Me.DOBTextBox
    If IsDate(.Value) Then
        .Value = Format(.Value, "m/d/yyyy")
    Else
        MsgBox "Please enter a valid date, such as: 4-15-20 (month-day-year)"
        Cancel = True
        .Value = Empty
    End If
End With
End Sub



Private Sub UserForm_Initialize()
Dim objControl As MSForms.Control

    For Each objControl In Me.Controls
        If TypeName(objControl) = "TextBox" And objControl.Tag <> "" Then
           Me.setupPlaceholder objControl.Name, False
        End If
    Next objControl

    Me.GenderComboBox.List = Array("M", "F")
    Me.GenderComboBox.Style = fmStyleDropDownCombo
       
    Me.OptionComboBox.List = Array("100% Joint Life", _
        "60% Joint Life 5-year guarantee", _
        "60% Joint Life 10-year guarantee", _
        "60% Joint Life 15-year guarantee", _
        "Single Life no guarantee", _
        "Single Life 5-year guarantee", _
        "Single Life 10-year guarantee", _
        "Single Life 15-year guarantee", _
        "Other")

    Dim LastRow As Long
    Dim SheetName As String
    SheetName = "Sheet20"
    LastRow = Sheets(SheetName).Cells(Rows.Count, "A").End(xlUp).Row
    Me.ProviderComboBox.List = Sheets("Sheet20").Range("A2:A" & LastRow).Value
    Me.SProviderComboBox.List = Sheets("Sheet20").Range("A2:A" & LastRow).Value
   
    Me.SGenderComboBox.List = Array("M", "F")
    Me.SGenderComboBox.Style = fmStyleDropDownCombo
   
    Me.SOptionComboBox.List = Array("100% Joint Life", _
        "60% Joint Life 5-year guarantee", _
        "60% Joint Life 10-year guarantee", _
        "60% Joint Life 15-year guarantee", _
        "Single Life no guarantee", _
        "Single Life 5-year guarantee", _
        "Single Life 10-year guarantee", _
        "Single Life 15-year guarantee", _
        "Other")

End Sub

Sub setupPlaceholder(txtBox As String, focus As Boolean)
    With Me.Controls(txtBox)
        If Len(.Text) = 0 And Not focus Then
            .Text = .Tag
            .ForeColor = vbGrayText
        ElseIf .Text = .Tag Then
            .Text = ""
            .ForeColor = vbWindowText
        End If
    End With
End Sub
Private Sub LastNameTextBox_Enter()
    setupPlaceholder LastNameTextBox.Name, True
End Sub
Private Sub LastNameTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder LastNameTextBox.Name, False
End Sub
Private Sub DOBTextBox_Enter()
    setupPlaceholder DOBTextBox.Name, True
End Sub
Private Sub DOBTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder DOBTextBox.Name, False
End Sub
Private Sub RDTextBox_Enter()
    setupPlaceholder RDTextBox.Name, True
End Sub
Private Sub RDTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder RDTextBox.Name, False
End Sub
Private Sub CPPTextBox_Enter()
    setupPlaceholder CPPTextBox.Name, True
End Sub
Private Sub CPPTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder CPPTextBox.Name, False
End Sub
Private Sub OASTextBox_Enter()
    setupPlaceholder OASTextBox.Name, True
End Sub
Private Sub OASTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder OASTextBox.Name, False
End Sub
Private Sub CompanyTextBox_Enter()
    setupPlaceholder CompanyTextBox.Name, True
End Sub
Private Sub CompanyTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder CompanyTextBox.Name, False
End Sub

Private Sub SLastNameTextBox_Enter()
    setupPlaceholder SLastNameTextBox.Name, True
End Sub
Private Sub SLastNameTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder SLastNameTextBox.Name, False
End Sub
Private Sub SDOBTextBox_Enter()
    setupPlaceholder SDOBTextBox.Name, True
End Sub
Private Sub SDOBTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder SDOBTextBox.Name, False
End Sub
Private Sub SRDTextBox_Enter()
    setupPlaceholder SRDTextBox.Name, True
End Sub
Private Sub SRDTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder SRDTextBox.Name, False
End Sub
Private Sub SCPPTextBox_Enter()
    setupPlaceholder SCPPTextBox.Name, True
End Sub
Private Sub SCPPTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder SCPPTextBox.Name, False
End Sub
Private Sub SOASTextBox_Enter()
    setupPlaceholder SOASTextBox.Name, True
End Sub
Private Sub SOASTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder SOASTextBox.Name, False
End Sub
Private Sub SCompanyTextBox_Enter()
    setupPlaceholder SCompanyTextBox.Name, True
End Sub
Private Sub SCompanyTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder SCompanyTextBox.Name, False
End Sub
 
Last edited by a moderator:

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,961
Office Version
  1. 365
Platform
  1. Windows
Ah, sorry, I should remove "Me." from the sub.
Replace my code with this one:
VBA Code:
Private Sub DOBTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With DOBTextBox
If .Value = "" Then Exit Sub
If IsDate(.Value) Then
    .Value = Format(.Value, "m/d/yyyy")
Else
    MsgBox "Please enter a valid date, such as: 4-15-20 (month-day-year)"
    Cancel = True
    .Value = Empty
End If
End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,318
Messages
5,623,976
Members
416,003
Latest member
indyman

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