[excel] Formatting MM/DD/YYYY dates in textbox in VBA

I'm looking for a way to automatically format the date in a VBA text box to a MM/DD/YYYY format, and I want it to format as the user is typing it in. For instance, once the user types in the second number, the program will automatically type in a "/". Now, I got this working (as well as the second dash) with the following code:

Private Sub txtBoxBDayHim_Change()
    If txtBoxBDayHim.TextLength = 2 or txtBoxBDayHim.TextLength = 5 then
    txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/"
End Sub

Now, this works great when typing. However, when trying to delete, it still enters in the dashes, so its impossible for the user to delete past one of the dashes (deleting a dash results in a length of 2 or 5, and the sub is then run again, adding in another dash). Any suggestions on a better way to do this?

This question is related to excel vba user-interface

The answer is


For a quick solution, I usually do like this.

This approach will allow the user to enter date in any format they like in the textbox, and finally format in mm/dd/yyyy format when he is done editing. So it is quite flexible:

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If TextBox1.Text <> "" Then
        If IsDate(TextBox1.Text) Then
            TextBox1.Text = Format(TextBox1.Text, "mm/dd/yyyy")
        Else
            MsgBox "Please enter a valid date!"
            Cancel = True
        End If
    End If
End Sub

However, I think what Sid developed is a much better approach - a full fledged date picker control.


Just for fun I took Siddharth's suggestion of separate textboxes and did comboboxes. If anybody's interested, add a userform with three comboboxes named cboDay, cboMonth and cboYear and arrange them left to right. Then paste the code below into the UserForm's code module. The required combobox properties are set in UserFormInitialization, so no additional prep should be required.

The tricky part is changing the day when it becomes invalid because of a change in year or month. This code just resets it to 01 when that happens and highlights cboDay.

I haven't coded anything like this in a while. Hopefully it will be of interest to somebody, someday. If not it was fun!

Dim Initializing As Boolean

Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As MSForms.Control
Dim cbo As MSForms.ComboBox

Initializing = True
With Me
    With .cboMonth
        '        .AddItem "month"
        For i = 1 To 12
            .AddItem Format(i, "00")
        Next i
        .Tag = "DateControl"
    End With
    With .cboDay
        '        .AddItem "day"
        For i = 1 To 31
            .AddItem Format(i, "00")
        Next i
        .Tag = "DateControl"
    End With
    With .cboYear
        '        .AddItem "year"
        For i = Year(Now()) To Year(Now()) + 12
            .AddItem i
        Next i
        .Tag = "DateControl"
    End With
    DoEvents
    For Each ctl In Me.Controls
        If ctl.Tag = "DateControl" Then
            Set cbo = ctl
            With cbo
                .ListIndex = 0
                .MatchRequired = True
                .MatchEntry = fmMatchEntryComplete
                .Style = fmStyleDropDownList
            End With
        End If
    Next ctl
End With
Initializing = False
End Sub

Private Sub cboDay_Change()
If Not Initializing Then
    If Not IsValidDate Then
        ResetMonth
    End If
End If
End Sub

Private Sub cboMonth_Change()
If Not Initializing Then
    ResetDayList
    If Not IsValidDate Then
        ResetMonth
    End If
End If
End Sub

Private Sub cboYear_Change()
If Not Initializing Then
    ResetDayList
    If Not IsValidDate Then
        ResetMonth
    End If
End If
End Sub

Function IsValidDate() As Boolean
With Me
    IsValidDate = IsDate(.cboMonth & "/" & .cboDay & "/" & .cboYear)
End With
End Function
Sub ResetDayList()
Dim i As Long
Dim StartDay As String

With Me.cboDay
    StartDay = .Text
    For i = 31 To 29 Step -1
        On Error Resume Next
        .RemoveItem i - 1
        On Error GoTo 0
    Next i
    For i = 29 To 31
        If IsDate(Me.cboMonth & "/" & i & "/" & Me.cboYear) Then
            .AddItem Format(i, "0")
        End If
    Next i
    On Error Resume Next
    .Text = StartDay
    If Err.Number <> 0 Then
        .SetFocus
        .ListIndex = 0
    End If
End With
End Sub

Sub ResetMonth()
Me.cboDay.ListIndex = 0
End Sub

Private Sub txtBoxBDayHim_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then 'only numbers and backspace
    If KeyAscii = 8 Then 'if backspace, ignores + "/"
    Else
        If txtBoxBDayHim.TextLength = 10 Then 'limit textbox to 10 characters
        KeyAscii = 0
        Else
            If txtBoxBDayHim.TextLength = 2 Or txtBoxBDayHim.TextLength = 5 Then 'adds / automatically
            txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/"
            End If
        End If
    End If
Else
KeyAscii = 0
End If
End Sub

This works for me. :)

Your code helped me a lot. Thanks!

I'm brazilian and my english is poor, sorry for any mistake.


While I agree with what's mentioned in the answers below, suggesting that this is a very bad design for a Userform unless copious amounts of error checks are included...

to accomplish what you need to do, with minimal changes to your code, there are two approaches.

  1. Use KeyUp() event instead of Change event for the textbox. Here is an example:

    Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    
        Dim TextStr As String
        TextStr = TextBox2.Text
    
        If KeyCode <> 8 Then ' i.e. not a backspace
    
            If (Len(TextStr) = 2 Or Len(TextStr) = 5) Then
                TextStr = TextStr & "/"
            End If
    
        End If
        TextBox2.Text = TextStr
    End Sub
    
  2. Alternately, if you need to use the Change() event, use the following code. This alters the behavior so the user keeps entering the numbers, as

    12072003
    

while the result as he's typing appears as

    12/07/2003

But the '/' character appears only once the first character of the DD i.e. 0 of 07 is entered. Not ideal, but will still handle backspaces.

    Private Sub TextBox1_Change()
        Dim TextStr As String

        TextStr = TextBox1.Text

        If (Len(TextStr) = 3 And Mid(TextStr, 3, 1) <> "/") Then
            TextStr = Left(TextStr, 2) & "/" & Right(TextStr, 1)
        ElseIf (Len(TextStr) = 6 And Mid(TextStr, 6, 1) <> "/") Then
            TextStr = Left(TextStr, 5) & "/" & Right(TextStr, 1)
        End If

        TextBox1.Text = TextStr
    End Sub

Add something to track the length and allow you to do "checks" on whether the user is adding or subtracting text. This is currently untested but something similar to this should work (especially if you have a userform).

'add this to your userform or make it a static variable if it is not part of a userform
private oldLength as integer

Private Sub txtBoxBDayHim_Change()
    if ( oldlength > txboxbdayhim.textlength ) then
        oldlength =txtBoxBDayHim.textlength
        exit sub
    end if

    If txtBoxBDayHim.TextLength = 2 or txtBoxBDayHim.TextLength = 5 then
    txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/"
    end if
    oldlength =txtBoxBDayHim.textlength
End Sub

I too, one way or another stumbled on the same dilemma, why the heck Excel VBA doesn't have a Date Picker. Thanks to Sid, who made an awesome job to create something for all of us.

Nonetheless, I came to a point where I need to create my own. And I am posting it here since a lot of people I'm sure lands on this post and benefit from it.

What I did was very simple as what Sid does except that I do not use a temporary worksheet. I thought the calculations are very simple and straight forward so there's no need to dump it somewhere else. Here's the final output of the calendar:

enter image description here

How to set it up:

  • Create 42 Label controls and name it sequentially and arranged left to right, top to bottom (This labels contains greyed 25 up to greyed 5 above). Change the name of the Label controls to Label_01,Label_02 and so on. Set all 42 labels Tag property to dts.
  • Create 7 more Label controls for the header (this will contain Su,Mo,Tu...)
  • Create 2 more Label control, one for the horizontal line (height set to 1) and one for the Month and Year display. Name the Label used for displaying month and year Label_MthYr
  • Insert 2 Image controls, one to contain the left icon to scroll previous months and one to scroll next month (I prefer simple left and right arrow head icon). Name it Image_Left and Image_Right

The layout should be more or less like this (I leave the creativity to anyone who'll use this).

enter image description here

Declaration:
We need one variable declared at the very top to hold the current month selected.

Option Explicit
Private curMonth As Date

Private Procedure and Functions:

Private Function FirstCalSun(ref_date As Date) As Date
    '/* returns the first Calendar sunday */
    FirstCalSun = DateSerial(Year(ref_date), _
                  Month(ref_date), 1) - (Weekday(ref_date) - 1)
End Function

Private Sub Build_Calendar(first_sunday As Date)
    '/* This builds the calendar and adds formatting to it */
    Dim lDate As MSForms.Label
    Dim i As Integer, a_date As Date

    For i = 1 To 42
        a_date = first_sunday + (i - 1)
        Set lDate = Me.Controls("Label_" & Format(i, "00"))
        lDate.Caption = Day(a_date)
        If Month(a_date) <> Month(curMonth) Then
            lDate.ForeColor = &H80000011
        Else
            If Weekday(a_date) = 1 Then
                lDate.ForeColor = &HC0&
            Else
                lDate.ForeColor = &H80000012
            End If
        End If
    Next
End Sub

Private Sub select_label(msForm_C As MSForms.Control)
    '/* Capture the selected date */
    Dim i As Integer, sel_date As Date
    i = Split(msForm_C.Name, "_")(1) - 1
    sel_date = FirstCalSun(curMonth) + i

    '/* Transfer the date where you want it to go */
    MsgBox sel_date

End Sub

Image Events:

Private Sub Image_Left_Click()

    If Month(curMonth) = 1 Then
        curMonth = DateSerial(Year(curMonth) - 1, 12, 1)
    Else
        curMonth = DateSerial(Year(curMonth), Month(curMonth) - 1, 1)
    End If

    With Me
        .Label_MthYr.Caption = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With

End Sub

Private Sub Image_Right_Click()

    If Month(curMonth) = 12 Then
        curMonth = DateSerial(Year(curMonth) + 1, 1, 1)
    Else
        curMonth = DateSerial(Year(curMonth), Month(curMonth) + 1, 1)
    End If

    With Me
        .Label_MthYr.Caption = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With

End Sub

I added this to make it look like the user is clicking the label and should be done on the Image_Right control too.

Private Sub Image_Left_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                                 ByVal X As Single, ByVal Y As Single)
    Me.Image_Left.BorderStyle = fmBorderStyleSingle
End Sub

Private Sub Image_Left_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Image_Left.BorderStyle = fmBorderStyleNone
End Sub

Label Events:
All of this should be done for all 42 labels (Label_01 to Lable_42)
Tip: Build the first 10 and just use find and replace for the remaining.

Private Sub Label_01_Click()
    select_label Me.Label_01
End Sub

This is for hovering over dates and clicking effect.

Private Sub Label_01_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BorderStyle = fmBorderStyleSingle
End Sub

Private Sub Label_01_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BackColor = &H8000000B
End Sub

Private Sub Label_01_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                             ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BorderStyle = fmBorderStyleNone
End Sub

UserForm Events:

Private Sub UserForm_Initialize()
    '/* This is to initialize everything */
    With Me
        curMonth = DateSerial(Year(Date), Month(Date), 1)
        .Label_MthYr = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With

End Sub

Again, just for the hovering over dates effect.

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)

    With Me
        Dim ctl As MSForms.Control, lb As MSForms.Label

        For Each ctl In .Controls
            If ctl.Tag = "dts" Then
                Set lb = ctl: lb.BackColor = &H80000005
            End If
        Next
    End With

End Sub

And that's it. This is raw and you can add your own twist to it.
I've been using this for awhile and I have no issues (performance and functionality wise).
No Error Handling yet but can be easily managed I guess.
Actually, without the effects, the code is too short.
You can manage where your dates go in the select_label procedure. HTH.


This is the same concept as Siddharth Rout's answer. But I wanted a date picker which could be fully customized so that the look and feel could be tailored to whatever project it's being used in.

You can click this link to download the custom date picker I came up with. Below are some screenshots of the form in action.

Three example calendars

To use the date picker, simply import the CalendarForm.frm file into your VBA project. Each of the calendars above can be obtained with one single function call. The result just depends on the arguments you use (all of which are optional), so you can customize it as much or as little as you want.

For example, the most basic calendar on the left can be obtained by the following line of code:

MyDateVariable = CalendarForm.GetDate

That's all there is to it. From there, you just include whichever arguments you want to get the calendar you want. The function call below will generate the green calendar on the right:

MyDateVariable = CalendarForm.GetDate( _
    SelectedDate:=Date, _
    DateFontSize:=11, _
    TodayButton:=True, _
    BackgroundColor:=RGB(242, 248, 238), _
    HeaderColor:=RGB(84, 130, 53), _
    HeaderFontColor:=RGB(255, 255, 255), _
    SubHeaderColor:=RGB(226, 239, 218), _
    SubHeaderFontColor:=RGB(55, 86, 35), _
    DateColor:=RGB(242, 248, 238), _
    DateFontColor:=RGB(55, 86, 35), _
    SaturdayFontColor:=RGB(55, 86, 35), _
    SundayFontColor:=RGB(55, 86, 35), _
    TrailingMonthFontColor:=RGB(106, 163, 67), _
    DateHoverColor:=RGB(198, 224, 180), _
    DateSelectedColor:=RGB(169, 208, 142), _
    TodayFontColor:=RGB(255, 0, 0), _
    DateSpecialEffect:=fmSpecialEffectRaised)

Here is a small taste of some of the features it includes. All options are fully documented in the userform module itself:

  • Ease of use. The userform is completely self-contained, and can be imported into any VBA project and used without much, if any additional coding.
  • Simple, attractive design.
  • Fully customizable functionality, size, and color scheme
  • Limit user selection to a specific date range
  • Choose any day for the first day of the week
  • Include week numbers, and support for ISO standard
  • Clicking the month or year label in the header reveals selectable comboboxes
  • Dates change color when you mouse over them

You could use an input mask on the text box, too. If you set the mask to ##/##/#### it will always be formatted as you type and you don't need to do any coding other than checking to see if what was entered was a true date.

Which just a few easy lines

txtUserName.SetFocus
If IsDate(txtUserName.text) Then
    Debug.Print Format(CDate(txtUserName.text), "MM/DD/YYYY")
Else
    Debug.Print "Not a real date"
End If

Examples related to excel

Python: Pandas pd.read_excel giving ImportError: Install xlrd >= 0.9.0 for Excel support Converting unix time into date-time via excel How to increment a letter N times per iteration and store in an array? 'Microsoft.ACE.OLEDB.16.0' provider is not registered on the local machine. (System.Data) How to import an Excel file into SQL Server? Copy filtered data to another sheet using VBA Better way to find last used row Could pandas use column as index? Check if a value is in an array or not with Excel VBA How to sort dates from Oldest to Newest in Excel?

Examples related to vba

Copy filtered data to another sheet using VBA Better way to find last used row Check if a value is in an array or not with Excel VBA Creating an Array from a Range in VBA Excel: macro to export worksheet as CSV file without leaving my current Excel sheet VBA: Convert Text to Number What's the difference between "end" and "exit sub" in VBA? Rename Excel Sheet with VBA Macro Extract Data from PDF and Add to Worksheet Quicker way to get all unique values of a column in VBA?

Examples related to user-interface

Calling another method java GUI How do I center text vertically and horizontally in Flutter? Is it possible to put a ConstraintLayout inside a ScrollView? How to change color of the back arrow in the new material theme? How to create RecyclerView with multiple view type? Android RecyclerView addition & removal of items tkinter: how to use after method Presenting a UIAlertController properly on an iPad using iOS 8 Android ViewPager with bottom dots How do I get the height and width of the Android Navigation Bar programmatically?