Monday, July 30, 2012

Validating Start and End Dates

I'm often using date specific queries to manage reports in excel and have found it handy to validate the start and end date to make sure that I'm entering the right thing !

Following the module using the date function : in this case I'm using the variables FromDate and ToDate


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 vMyStart As Variant, vMyEnd As Variant

    '----------------------------------------------------------------------------
    ' Code below taken with advice from
    ' http://www.mrexcel.com/forum/showthread.php?t=274520
    '----------------------------------------------------------------------------

    vMyStart = ""
    vMyEnd = ""
    Do
        bError = False
        sErrorMessage = ""
        vMyStart = Application.InputBox(Prompt:="Enter Month Start date (dd/mm/yy)", _
                                             Title:="Start Date", _
                                             Default:=vMyStart)

        If IsDate(vMyStart) = False Then
            bError = True
            vMyStart = ""
            sErrorMessage = "Start date not a date"
        Else
            If CheckDateInRange(Datex:=vMyStart, _
                                MinDate:=MinDate, _
                                MaxDate:=MaxDate) = False Then
                bError = True
                sErrorMessage = "Month start Date is not in range"
                vMyStart = ""
            End If

            If bError = False Then
                vMyEnd = Application.InputBox(Prompt:="Enter Month End date (dd/mm/yy)", _
                                                   Title:="End Date", _
                                                   Default:=vMyEnd)
                If IsDate(vMyEnd) = False Then
                    bError = True
                    sErrorMessage = "End date is not a date"
                    vMyEnd = ""
                End If
            End If

            If bError = False Then
                If CheckDateInRange(Datex:=vMyEnd, _
                                    MinDate:=MinDate, _
                                    MaxDate:=MaxDate) = False Then
                    bError = True
                    sErrorMessage = "End Date is not in range"
                    vMyEnd = ""
                End If
            End If

            If vMyEnd < vMyStart Then
                bError = True
                sErrorMessage = "Start Date not before End date"
                vMyEnd = ""
            End If

        End If
        If bError Then MsgBox Prompt:=sErrorMessage, Buttons:=vbOKOnly + vbCritical, Title:="Invalid Date!"
    Loop While bError

    FromDate = CDate(vMyStart)
    ToDate = CDate(vMyEnd)
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



No comments:

Post a Comment