Date Validations using VBA code

[Familiar_Str]

Hi All,

I am trying to validate the date which is entered in the Input box using the IsDate functions and some If conditions.
I am using a Do While Loop with two conditions ...meaning the loop should keep displaying the inputbox if an invalid date is entered.
But instead the Loop exits even if only one of the two conditions is met .
Please help ...
I have posted the code below



Received_Date = InputBox("Please enter the Received Date in dd-mmm-yyyy format", "Received Date ")

If Received_Date = vbNullString Then
'MsgBox ("User selected Cancel")
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Exit Sub
End If

In_Valid_Date = "N"
dd_part = Left(Received_Date, 2)
If dd_part > 31 Then
In_Valid_Date = "Y"
End If

Result = IsDate(Received_Date)

Do While ((In_Valid_Date <> "N") And (Result <> "True"))
Received_Date = InputBox("Please enter a valid date in dd-mmm-yy format", "Received Date ")
Result = IsDate(Received_Date)
dd_part = Left(Received_Date, 2)

If dd_part > 31 Then
In_Valid_Date = "Y"
Else
In_Valid_Date = "N"
End If

'cancel button check

If Received_Date = vbNullString Then
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Exit Sub
End If
Loop


Please help me to resolve this.

[GTO]

Hi there,

Just to confirm: you are requiring the user to enter the standard abbreviation for the month?

Mark

[Familiar_Str]

yes..I want the user to enter the standard abbreviation for the month

[GTO]

Okay then... I did not test yours, but in looking at it I noticed this bit:

If dd_part > 31 Then
In_Valid_Date = "Y"
End If

What I was thinking is that because some months have less than 31 days, maybe we should test against the date entered. Anyways, hopefully I didn't miss too much (a bit tired at the moment). Try:



Sub Test()
Dim dateNeededDate As Date

If DateConfirmed(dateNeededDate) Then
MsgBox "Now we can do something with the date: " & dateNeededDate
Else
MsgBox "Exiting..."
End If

End Sub


Function DateConfirmed(InputOutput As Date) As Boolean
Dim sRawReturn As String
Dim dateTemp As Date
Dim sDefault As String


'// Provide the current date as the default, formatted as desired, to give the user a hint.//
sDefault = Format(Date, "dd-mmm-yyyy")

Do
'// Return the user's input in UCASE and stripped of any spaces to lessen our headaches in figuring out what date they mean.//
sRawReturn = UCase$(Replace(Application.InputBox("Enter...", "Date needed...", sDefault, Type:=2), Chr$(32), vbNullString))

'// Initail test requiring 0 thru 3 for the first digit, and so on (see help for Like)
If Not sRawReturn Like "[0-3][0-9]-[JFMASOND][AEPUCO][NBRYLGPTVC]-20[0-1][0-9]" Then
sDefault = vbNullString
MsgBox "Bad entry; try again..."
GoTo Jump
End If

'// If we passed the above test, then confirm that the three alpha chracter string is a valid month abbreviation.//
If Not InStr(1, "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC", Mid$(sRawReturn, 4, 3)) > 0 Then
sDefault = vbNullString
MsgBox "Non standard month abbreviation entered; try again.", vbOKOnly, vbNullString
GoTo Jump
End If

'// return a temp date of the last day of the month/year the user entered: Year is from right 4 digits, month is based on where //
'// we found the string in an array of strings using the worksheet function MATCH. We add 1 to this, to give us the next month, //
'// which is dropped back to the last day of the month entered, by using 0 as the Day argument in DateSerial //
dateTemp = _
DateSerial(Year:=Right(sRawReturn, 4), _
Month:=Evaluate("MATCH(""" & Mid$(sRawReturn, 4, 3) & _
""",{""JAN"",""FEB"",""MAR"",""APR"",""MAY"",""JUN"",""JUL"",""AUG"",""SEP"",""OCT"",""NOV"",""DEC""}" & _
",0)") _
+ 1, _
Day:=0)

'// Now just compare the numerical value of the user's input to the end of the month the user entered.
If Not CLng(Left$(sRawReturn, 2)) > Day(dateTemp) Then
InputOutput = dateTemp
DateConfirmed = True
Else
MsgBox CLng(Left$(sRawReturn, 2)) & " exceeds the number of days in the month/year specified; try again.", vbOKOnly, vbNullString
sDefault = vbNullString
End If

Jump:
Loop While Not Year(InputOutput) > 1999 And Not sRawReturn = "FALSE"

End Function

Does that help? I'll check tonight, by which time I'm sure someone will have helped you already :-)

Mark

[Paul_Hossler]

I usually do something like this and let Excel do all the heavy lifting





Option Explicit
Sub PHH()
Dim Received_Date As String
Dim Is_Valid_Date As Boolean
Dim Date_Received_Date As Date



Is_Valid_Date = False

Do While Not Is_Valid_Date

Received_Date = vbNullString

Do While Not Received_Date Like "##-???-####"

Received_Date = InputBox("Please enter the Received Date in dd-mmm-yyyy format", "Received Date ")
If Received_Date = vbNullString Then
'MsgBox ("User selected Cancel")
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Sheet1").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Exit Sub
End If
Loop

If IsDate(Received_Date) Then
Date_Received_Date = CDate(Received_Date)

MsgBox "Date = " & Format(Date_Received_Date, "dd-mmm-yyyy")

Is_Valid_Date = True
End If
Loop
End Sub

[snb]

Use a combobox containing only valid dates.

[SamT]

Use SpinButton(s) to select dates.