VBA-Validating User inputted Start and End Dates

Nyanko

Active Member
Joined
Sep 1, 2005
Messages
437
Hi,

I've had a search, but can't seem to find the right information !!

I have several macros that require users to input a start and end date to return a report based on these parametres. My question is how to validate the dates input so they can only enter within certain periods, and how to check that it is a proper date !!!

I have pieced together the following, but I know it's flawed :

Code:
    AbsenceStart = InputBox("Type month start date in format dd/mm/yy", "Start Date")
      If AbsenceStart = "" Then MsgBox ("No Date Entered")
      End If
      If IsDate(AbsenceStart) Then
    AbsenceEnd = InputBox("Type month end date in format dd/mm/yy", "End Date")
      If AbsenceEnd = "" Then MsgBox ("No Date Entered")
      End If
      If IsDate(AbsenceEnd) Then
    Resume Next
   Else
    MsgBox "You did not enter a valid date.", 48, "Invalid Date !"
    End If
    End If

The macro should finish and error message if :
If user enters nothing (or cancels)
If user enters text/non numerical
If user enters a date outside set period (not between 01/01/07 and 31/12/07)
If user enters a bizzare/non valid format i.e 001/decem/07

Otherwise the start and end date are recorded as AbsenceStart and AbsenceEnd to be used later on in the program.

It doesn't matter what format is entered 01/06/07 01-06-2007 01 June 2007 as long as excel understands that all of these formatts mean the same date.

Can anyone offer a suggestion ?
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Hi,

Try this:
Code:
Option Explicit
Sub TestBed()
Dim datFrom As Date, datTo As Date

GetValidDates FromDate:=datFrom, ToDate:=datTo

MsgBox "Date range " & Format(datFrom, "dd/mm/yy") & " to " & Format(datTo, "dd/mm/yy")
End Sub

Public Sub GetValidDates(ByRef FromDate As Date, ByRef ToDate As Date)
Dim bError As Boolean
Dim sErrorMessage As String
Dim vAbsenceStart As Variant, vAbsenceEnd As Variant

vAbsenceStart = ""
vAbsenceEnd = ""
Do
    bError = False
    sErrorMessage = ""
    vAbsenceStart = Application.InputBox(prompt:="Enter Month Start date (dd/mm/yy)", _
                                         Title:="Start Date", _
                                         Default:=vAbsenceStart)
    If IsDate(vAbsenceStart) = False Then
        bError = True
        vAbsenceStart = ""
        sErrorMessage = "Start date not a date"
    Else
        vAbsenceEnd = Application.InputBox(prompt:="Enter Month End date (dd/mm/yy)", _
                                           Title:="End Date", _
                                           Default:=vAbsenceEnd)
        If IsDate(vAbsenceEnd) = False Then
            bError = True
            sErrorMessage = "End date is not a date"
        End If
        If bError = False Then
            If vAbsenceEnd < vAbsenceStart Then
                bError = True
                sErrorMessage = "End date after start date"
            End If
        End If
        If bError Then vAbsenceEnd = ""
    End If
    If bError Then MsgBox prompt:=sErrorMessage, Buttons:=vbOKOnly + vbCritical, Title:="Invalid Date!"
Loop While bError

FromDate = CDate(vAbsenceStart)
ToDate = CDate(vAbsenceEnd)
End Sub

Replace the TestBed sub as appropriate.
 
Upvote 0
Hi many thanks for your solution (it looks very complicated - but exciting !!!)

I get the following error :
Compile error:
Wrong number of arguments or invalid property assignment
at
Rich (BB code):
MsgBox "Date range " & Format(datFrom, "dd/mm/yy") & " to " & Format(datTo, "dd/mm/yy")

I'm also having trouble intigrating it into my existing code as the sub/end sub is causing the code to do weird things !!

At the moment what I have either side is :

Rich (BB code):
Sheets.Add
    ActiveSheet.Name = "sicktemp"
    Sheets("Roster").Rows("4:4").Copy Destination:=Sheets("sicktemp").Range("A1")
    Sheets("Roster").Rows("15:15").Copy Destination:=Sheets("sicktemp").Range("A2")
    Sheets("Roster").Rows("16:16").Copy Destination:=Sheets("sicktemp").Range("A3")
    Sheets("Roster").Select

***********
    AbsenceStart = InputBox("Type month start date in format dd/mm/yy")
    AbsenceEnd = InputBox("Type month end date in format dd/mm/yy")
***********
   
'Searches the roster file for start and end absence month dates
    Sheets("Roster").Columns("E").Find(AbsenceStart).Select 'finds the start date directly

When I try to paste in your solution ... it doesn't like it !!!
 
Upvote 0
Hi,

If your code is in a sub called 'NYankosCode', try the following - note I've defined 'AbsenceStart' and 'AbsenceEnd' as variable type 'Date'.

Code:
Sub NyankosCode()
Dim AbsenceStart As Date, AbsenceEnd As Date

'....

Sheets.Add
    ActiveSheet.Name = "sicktemp"
    Sheets("Roster").Rows("4:4").Copy Destination:=Sheets("sicktemp").Range("A1")
    Sheets("Roster").Rows("15:15").Copy Destination:=Sheets("sicktemp").Range("A2")
    Sheets("Roster").Rows("16:16").Copy Destination:=Sheets("sicktemp").Range("A3")
    Sheets("Roster").Select

    GetValidDates AbsenceStart, AbsenceEnd
    
'Searches the roster file for start and end absence month dates
    Sheets("Roster").Columns("E").Find(AbsenceStart).Select 'finds the start date directly

'.....

End Sub

Public Sub GetValidDates(ByRef FromDate As Date, ByRef ToDate As Date)
Dim bError As Boolean
Dim sErrorMessage As String
Dim vAbsenceStart As Variant, vAbsenceEnd As Variant

vAbsenceStart = ""
vAbsenceEnd = ""
Do
    bError = False
    sErrorMessage = ""
    vAbsenceStart = Application.InputBox(prompt:="Enter Month Start date (dd/mm/yy)", _
                                         Title:="Start Date", _
                                         Default:=vAbsenceStart)
    If IsDate(vAbsenceStart) = False Then
        bError = True
        vAbsenceStart = ""
        sErrorMessage = "Start date not a date"
    Else
        vAbsenceEnd = Application.InputBox(prompt:="Enter Month End date (dd/mm/yy)", _
                                           Title:="End Date", _
                                           Default:=vAbsenceEnd)
        If IsDate(vAbsenceEnd) = False Then
            bError = True
            sErrorMessage = "End date is not a date"
        End If
        If bError = False Then
            If vAbsenceEnd < vAbsenceStart Then
                bError = True
                sErrorMessage = "End date after start date"
            End If
        End If
        If bError Then vAbsenceEnd = ""
    End If
    If bError Then MsgBox prompt:=sErrorMessage, Buttons:=vbOKOnly + vbCritical, Title:="Invalid Date!"
Loop While bError

FromDate = CDate(vAbsenceStart)
ToDate = CDate(vAbsenceEnd)
End Sub
 
Upvote 0
Ahhh I see.

However I've been able to enter dates such as 56/01/07 and 311/01/07 !! Is there any way to limit the entry to between two dates (i.e. 01/01/07 and 31/12/07) ?

Many thanks again !
 
Upvote 0
Code:
Sub NyankosCode()
Dim AbsenceStart As Date, AbsenceEnd As Date

'....

Sheets.Add
    ActiveSheet.Name = "sicktemp"
    Sheets("Roster").Rows("4:4").Copy Destination:=Sheets("sicktemp").Range("A1")
    Sheets("Roster").Rows("15:15").Copy Destination:=Sheets("sicktemp").Range("A2")
    Sheets("Roster").Rows("16:16").Copy Destination:=Sheets("sicktemp").Range("A3")
    Sheets("Roster").Select

    GetValidDates FromDate:=AbsenceStart, _
                  ToDate:=AbsenceEnd, _
                  MinDate:=DateSerial(2007, 1, 1), _
                  MaxDate:=DateSerial(2007, 12, 31)
    
'Searches the roster file for start and end absence month dates
    Sheets("Roster").Columns("E").Find(AbsenceStart).Select 'finds the start date directly

'.....

End Sub
Public Sub GetValidDates(ByRef FromDate As Date, _
                         ByRef ToDate As Date, _
                         Optional MinDate As Date, _
                         Optional MaxDate As Date)
Dim bError As Boolean
Dim sErrorMessage As String
Dim vAbsenceStart As Variant, vAbsenceEnd As Variant

vAbsenceStart = ""
vAbsenceEnd = ""
Do
    bError = False
    sErrorMessage = ""
    vAbsenceStart = Application.InputBox(prompt:="Enter Month Start date (dd/mm/yy)", _
                                         Title:="Start Date", _
                                         Default:=vAbsenceStart)
    If IsDate(vAbsenceStart) = False Then
        bError = True
        vAbsenceStart = ""
        sErrorMessage = "Start date not a date"
    Else
        If CheckDateInRange(Datex:=vAbsenceStart, _
                            MinDate:=MinDate, _
                            MaxDate:=MaxDate) = False Then
            bError = True
            sErrorMessage = "Month start Date is not in range"
            vAbsenceStart = ""
        End If
                
        If bError = False Then
            vAbsenceEnd = Application.InputBox(prompt:="Enter Month End date (dd/mm/yy)", _
                                               Title:="End Date", _
                                               Default:=vAbsenceEnd)
            If IsDate(vAbsenceEnd) = False Then
                bError = True
                sErrorMessage = "End date is not a date"
                vAbsenceEnd = ""
            End If
        End If
                
        If bError = False Then
            If CheckDateInRange(Datex:=vAbsenceEnd, _
                                MinDate:=MinDate, _
                                MaxDate:=MaxDate) = False Then
                bError = True
                sErrorMessage = "End Date is not in range"
                vAbsenceEnd = ""
            End If
        End If
        
        If vAbsenceEnd < vAbsenceStart Then
            bError = True
            sErrorMessage = "Start Date not before End date"
            vAbsenceEnd = ""
        End If
        
    End If
    If bError Then MsgBox prompt:=sErrorMessage, Buttons:=vbOKOnly + vbCritical, Title:="Invalid Date!"
Loop While bError

FromDate = CDate(vAbsenceStart)
ToDate = CDate(vAbsenceEnd)
End Sub
Private Function CheckDateInRange(ByVal Datex As Variant, _
                                Optional MinDate As Date, _
                                Optional MaxDate As Date) As Boolean
'--Return False if specified date is not in range --
Dim datCur As Date

On Error GoTo labError
datCur = CDate(Datex)
If Not (IsMissing(MinDate)) Then
    If datCur < MinDate Then
        CheckDateInRange = False
        Exit Function
    End If
End If

If Not (IsMissing(MaxDate)) Then
    If datCur > MaxDate Then
        CheckDateInRange = False
        Exit Function
    End If
End If

CheckDateInRange = True
Exit Function

labError:
CheckDateInRange = False
End Function
 
Upvote 0
Thank you.

You're a genius ! It'll take me a while to figure that out, but I'm very grateful !
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,999
Members
448,543
Latest member
MartinLarkin

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