The Date Picker is a safe method to always ensure valid dates to be entered without noisy error messages disturbing the user. However, for many scenarios like accounting and statistics, the Date Picker method is way to slow for the fast-typing user because of the many mouse-clicks needed.
Entering a date in a textbox is the fast method but, in case of a typo, navigating in the textbox is not optimal, and the user will meet an unfriendly error message. In many cases, applying an inputmask may help, but not for dates because the validation options are far too limited; you can still easily input day 31 for, say, June and an error message is popped..
To sort this out, code is needed. The inputmask adds the option that the code always will know where the user is typing, thus it can prevent and correct many typing errors. For example, if the first month digit is zero, the second month digit can be any digit except zero, but if the first is one, the second can be zero, though not higher than two. And the last day of February is 29 in leap years and not 28 as in common years. Does the user input 2014-02-29, the code will silently correct to 2014-02-28.
To have a textbox that just works for entering date takes several steps:
That may seem like a lot, but the outcome is a highly optimised control demonstrating the true power of an input mask.
The first and the last item are quite simple.
The input mask is, as no digit is optional (it is assumed that years must be larger then 1000):
and the format is:
This makes the textbox contain as default (where the slash will be replaced by your local date separator ):
These can be set when the form loads. Note, that a default date should be set to avoid an "all-zeroes" invalid date:
Option Compare Database
Option Explicit
Dim DefaultDate As Date
Dim DefaultFormat As String
Dim DefaultInputMask As String
Private Sub Form_Load()
Dim InitialDate As Date
' Set initial date.
InitialDate = Date
' Format and length of DefaultFormat and
' first part of DefaultInputMask must match.
DefaultFormat = "yyyy/mm/dd"
DefaultInputMask = "0000/00/00;1;0"
Me!Logon.Format = DefaultFormat
Me!Logon.InputMask = DefaultInputMask
Me!Logon.ShowDatePicker = False
SetDefaultDate InitialDate
End Sub
That's not much, but then comes the code behind for the control.
First, set a default date. This may be dynamic (controlled by other code), but here it is static for simplicity:
Private Sub Logon_Enter()
With Me!Logon
If IsNull(.Value) Then
.Value = DefaultDate
End If
End With
End Sub
Second, when clicking in the control, avoid ever having to select one of the separators (slash):
Private Sub Logon_Click()
Dim SelStart As Integer
With Me!Logon
If .SelStart = 4 Or .SelStart = 7 Then
' Move the cursor off the separator (slash)
' to the first digit of months or days.
.SelStart = .SelStart + 1
End If
SelStart = .SelStart
.SelStart = SelStart
.SelLength = 1
End With
End Sub
Now comes the fun part -- to try to be smart, helping the user by correcting invalid values while still allowing the normal key entries for navigating inside the control as well as away from the control:
Private Sub Logon_KeyPress(KeyAscii As Integer)
Dim Text As String
Dim Length As Integer
Dim SelStart As Integer
With Me!Logon
Select Case KeyAscii
Case vbKeyBack, vbKeyTab, Asc(vbLf), vbKeyReturn, vbKeyEscape, vbKeyF16
' Allow navigation etc. with
' BackSpace, Tab, Ctrl+Enter, Enter, Escape, Ctrl+BackSpace
Case Is > 0
Text = .Text
Length = Len(Text)
SelStart = .SelStart
If KeyAscii < vbKey0 Or KeyAscii > vbKey9 Then
' Replace any invalid entry with a zero.
KeyAscii = vbKey0
End If
If SelStart < Length Then
Select Case SelStart
' Year part.
Case Is = 0
' First digit of year.
If KeyAscii = vbKey0 Then
' No year before 1000.
KeyAscii = vbKey1
End If
' Month part.
Case Is = 5
' First digit of month.
If KeyAscii > vbKey1 Then
' No month with tens beyond 1.
KeyAscii = vbKey1
End If
Case Is = 6
' Second digit of month.
Select Case Val(Mid(.Text, 6, 1))
Case Is = 0
' Month is < 10.
If KeyAscii = vbKey0 Then
' Month cannot be 00.
KeyAscii = vbKey1
End If
Case Is > 0
' Month is 10+.
If KeyAscii > vbKey2 Then
' No month beyond 12.
KeyAscii = vbKey2
End If
End Select
' Day part.
Case Is = 8
' First digit of day.
Select Case Val(Mid(.Text, 6, 2))
Case Is = 2
' Month is February.
If KeyAscii > vbKey2 Then
' No day with tens beyond 2 for February.
KeyAscii = vbKey2
End If
Case Else
If KeyAscii > vbKey3 Then
' No day with tens beyond 3.
KeyAscii = vbKey3
End If
End Select
Case Is = 9
' Second digit of day.
Select Case Mid(.Text, 9, 1)
Case Is = 3
' Days of 30.
Select Case Val(Mid(.Text, 6, 2))
Case 1, 3, 5, 7, 8, 10, 12
If KeyAscii > vbKey1 Then
' No day beyond 31.
KeyAscii = vbKey1
End If
Case 4, 6, 9, 11
If KeyAscii > vbKey0 Then
' No day beyond 30.
KeyAscii = vbKey0
End If
End Select
Case Is = 2
' Days of 20.
Select Case Val(Mid(.Text, 6, 2))
Case 2
If KeyAscii = vbKey9 Then
' Check for leap year.
If Month(DateAdd("d", 1, DateSerial(Val(Mid(.Text, 1, 4)), 2, 28))) = 3 Then
' Not a leap year.
KeyAscii = vbKey8
End If
End If
End Select
Case Is = 0
' Days of 00.
If KeyAscii = vbKey0 Then
' No day of 00.
KeyAscii = vbKey1
End If
End Select
End Select
End If
End Select
End With
End Sub
You will notice, that first the position where the user enters a digit is found, then what part (year, month, day) is current, and then what to correct. Please study the in-line comments for the subtle details.
The method is, that - from left to right - the user can enter whatever digit, but - as he/she proceeds - the input for the next digit is corrected if needed. For example, if February is entered, no day in the thirties can be entered, thus a 3 or higher is silently changed to a 2.
Not all validation can be done this way - for example, the user may click directly on a digit and delete it, leaving a zero which might add up to an invalid date expression. These situations are handled by the form:
Private Sub Form_Error(DataErr As Integer, Response As Integer)
Dim ctl As Control
Dim SelStart As Integer
On Error Resume Next
Set ctl = Screen.ActiveControl
Select Case ctl.Name
Case "Logon"
SelStart = ctl.SelStart
' Clear deleted digits by resetting the input mask.
ctl.InputMask = DefaultInputMask
ctl.SelStart = SelStart
ctl.SelLength = 1
Response = acDataErrContinue
End Select
Set ctl = Nothing
End Sub
Note, that it will always leave some date value in the control.
When done, you may set a new default value:
Private Sub Logon_AfterUpdate()
With Me!Logon
If IsNull(.Value) Then
' Rem this line out to allow the textbox to be cleared.
.Value = DefaultDate
ElseIf .Value < DateSerial(9999, 12, 31) Then
SetDefaultDate DateAdd("d", 1, .Value)
Else
SetDefaultDate .Value
End If
End With
End Sub
Private Sub SetDefaultDate(ThisDate As Date)
DefaultDate = ThisDate
Me!Logon.DefaultValue = Format(ThisDate, "\#yyyy\/mm\/dd\#")
End Sub
Note the conversion of the date value as a formatted string expression, as DefaultValue is a string.
To test it for yourself, download and run the demo application. It is a simple form created in Access 2013 that should work as is for all versions of Access from 2007 to 2019/365. However, the code should be adoptable with minor changes for any version of Access.
The zip file also contains the Time Entry form from the previous and related article:
Entering 24-hour time with input mask and full validation in Microsoft AccessYou can also obtain the code from Github: VBA.DateEntry
I hope you found this article useful. You are encouraged to ask questions, report any bugs or make any other comments about it below.
Note: If you need further "Support" about this topic, please consider using the Ask a Question feature of Experts Exchange. I monitor questions asked and would be pleased to provide any additional support required in questions asked in this manner, along with other EE experts.
Please do not forget to press the "Thumbs Up" button if you think this article was helpful and valuable for EE members.
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (9)
Author
Commented:https://en.wikipedia.org/wiki/Date_format_by_country
Do you have a reference for its use in the US?
/gustav
Commented:
Author
Commented:/gustav
Commented:
http://recoilmag.com/poll-73-percent-of-americans-unable-to-locate-america-on-map-of-america-2/
Author
Commented:/gustav
View More