We help IT Professionals succeed at work.

vba date validation

597 Views
Last Modified: 2012-05-10
I want to validate in vba that an inputbox entry is between two dates: two yrs ago and 10 yrs hence..  If true, continue; if false msg box and try again.
Comment
Watch Question

Commented:
you don't need vba for that :

you just have to use data-validation on that cell, with a personalized formula as :
(for checking value in I9 between
=ET(I9>J9;I9<J10)

with J9 = 2 years ago
and J10= 10 years hence

you can personalize the message that will be displayed to the user.
He cannot validate a wrong value in the field.

Commented:
Sorry, French version of Excel ...

in english :
=AND(I9>J9;I9<J10)
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
ymiossec uses semicolons as a list separator. In American Excel, you would use a comma.
=AND(I9>=J9,I9<=J10)                                Formula changed so allowable dates would also include the end points

Author

Commented:
I need vba because: 1) my entries are made on a userform, not spreadsheet; 2) the date extremes are based on today's date (dynamic), not a hard date..  I also like the msgbox to indicate out of range date.
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
The code in the snippet assumes you enter the date as a string in a textbox named TextBox1 on a userform. The date is tested when the user hits the OK button.
Private Sub cbCancel_Click()
Me.Hide
Unload Me
End Sub

Private Sub cbOK_Click()
Dim dat As Date
If IsDate(TextBox1.Value) Then
    dat = CDate(TextBox1.Value)
    Select Case dat
    Case Is < DateSerial(Year(Date) - 2, Month(Date), Day(Date))
        MsgBox "Date is too soon. Try again."
    Case Is > DateSerial(Year(Date) + 10, Month(Date), Day(Date))
        MsgBox "Date is too far in future. Try again."
    Case Else
        'Good date. Do stuff
        MsgBox "A good date was entered: " & Format(dat, "mmmm d, yyyy")
    End Select
End If
End Sub

Open in new window

ValidateDateQ26479360.xlsm
Try this:
Sub InputBoxCode()
Dim d  As Date


d = InputBox("Enter Date")
If d < DateSerial(Year(Date) - 2, Month(Date), Day(Date)) Or d > DateSerial(Year(Date) + 10, Month(Date), Day(Date)) Then
MsgBox "Date is out of specified time frame!"
Exit Sub
Else
    'Rest of Code
End If

End Sub

Open in new window

Author

Commented:
Attched is "wire" workbook.  I believe your code should be in Calendar1 so when date is selected your code will run.  I've tried both of your code ideas, but neither work.  Thanks for your patience.
WIRE-2010.xlsm
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
You don't have a CommandButton3 in your userform. When I added one, the macro tested the date as expected.

I tested the code as shown below. Note that I deleted some extra End Sub statements and commented out the original code for CommandButton3.

Brad
Private Sub CommandButton3_Click()
'Range("H1").Select
    'Range(Selection, Selection.End(xlDown)).Select
    'Range(Selection, Selection.End(xlToLeft)).Select
    'ActiveSheet.PageSetup.PrintArea = Selection.Address
    'ActiveWindow.SelectedSheets.PrintPreview


'Private Sub TextBox1_Change()
'Private Sub cbCancel_Click()
'Me.Hide
'Unload Me
'End Sub

'Private Sub cbOK_Click()
Dim dat As Date
If IsDate(TextBox1.Value) Then
    dat = CDate(TextBox1.Value)
    Select Case dat
    Case Is < DateSerial(Year(Date) - 2, Month(Date), Day(Date))
        MsgBox "Date is too soon. Try again."
    Case Is > DateSerial(Year(Date) + 10, Month(Date), Day(Date))
        MsgBox "Date is too far in future. Try again."
    Case Else
        'Good date. Do stuff
        MsgBox "A good date was entered: " & Format(dat, "mm, dd, yy")
    End Select
End If
End Sub

Open in new window

Mechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.