Description
A new utility I built to ask users to input a date range (StartDate + EndDate).
Function AskDateRange() that handles loading/unloading the form and passing back input.
The userform itself, ufAskDateRange. Which validates that the user has entered text that looks like a date.
Review Aims
These days, my focus is on ease-of-maintenance, so please critique accordingly.
If you saw this code in a legacy system, how would you be feeling?
Calling the Function
Public Sub TestAskDateRange()
Dim startDate As Date
Dim endDate As Date
Dim result As Boolean
result = AskDateRange(startDate, endDate, CDate("01/01/2017"), CDate("07/07/2018"))
End Sub
AskDateRange()
Public Function AskDateRange(ByRef startDate As Date, ByRef endDate As Date, Optional ByVal defaultStartDate As Date, Optional ByVal defaultEndDate As Date) As Boolean
'/ If default dates are supplied, insert them into the relevant textboxes
'/ Show the ufAskDateRange Userform
'/ Form handles user input
'/ Check for form exit conditions
'/ Returns TRUE if the form exited properly, FALSE otherwise
'/ If TRUE, pass back inputs.
'/ If FALSE, pass back 0-dates
With ufAskDateRange
'/ Set defaults
If defaultStartDate > 0 Then .startDate = defaultStartDate
If defaultEndDate > 0 Then .endDate = defaultEndDate
.Show
'/ Check for form Exit
AskDateRange = .ValidExit
If .ValidExit Then
startDate = .startDate
endDate = .endDate
End If
End With
Unload ufAskDateRange
End Function
ufAskDateRange()
Private pDateFormat As String
Private pValidExit As Boolean
Public Property Get ValidExit() As Boolean
ValidExit = pValidExit
End Property
Public Property Get startDate() As Date
startDate = CDate(txtStartDate.Text)
End Property
Public Property Let startDate(ByVal startDate As Date)
txtStartDate.Text = startDate
End Property
Public Property Get endDate() As Date
endDate = CDate(txtEndDate.Text)
End Property
Public Property Let endDate(ByVal endDate As Date)
txtEndDate.Text = endDate
End Property
Private Sub UserForm_Initialize()
'/ Determine system date format and update userform display
Select Case Application.International(xlDateOrder)
Case 0
'/ Month-Day-Year
pDateFormat = "MM/DD/YYYY"
Case 1
'/ Day-Month-Year
pDateFormat = "DD/MM/YYYY"
Case 2
'/ Year-Month-Day
pDateFormat = "YYYY/MM/DD"
End Select
lbStartDateFormat.Caption = pDateFormat
lbEndDateFormat.Caption = pDateFormat
'/ Set exit check
pValidExit = False
End Sub
Private Sub UserForm_Terminate()
'/ Clear Input Boxes
txtStartDate.Text = ""
txtEndDate.Text = ""
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'/ Try to force exit via the submit button
If CloseMode = 0 Then
cmdSubmitDates_Click
Cancel = True
End If
End Sub
Private Sub cmdSubmitDates_Click()
'/ Validate input boxes as dates. Require 10 digits to catch potential missing digits/mistyped dates
If Not IsDate(txtStartDate.Text) Or Len(txtStartDate.Text) <> 10 Then
MsgBox "Start Date is not in a recognised date format. Please input a new date"
txtStartDate.SetFocus
GoTo FailedValidation
End If
If Not IsDate(txtEndDate.Text) Or Len(txtEndDate.Text) <> 10 Then
MsgBox "End Date is not in a recognised date format. Please input a new date"
txtEndDate.SetFocus
GoTo FailedValidation
End If
pValidExit = True
Me.Hide
FailedValidation:
Exit Sub '/ return focus to userform, having been prompted by the MsgBox
End Sub
