DatePicker

There was a built-in DateTimePicker control but this only works with Office 32-Bit, not Office 365 (which is 64-Bit).
It is possible to select and validate your dates using a combination of built-in controls.

alt text

This uses a combination of two TextBoxes, two SpinButtons and one ComboBox.
This alternative works with Office 365 and is fully backwards compatible with all earlier 32-Bit versions on Office.


Choosing The Day

To enter the day either type a number straight in or use the spin buttons to increment or decrement the current number.

alt text

Choosing The Month

To enter the month use the drop-down to select the month.

alt text

Choosing The Year

To enter the year either type a number straight in or use the spin buttons to increment or decrement the current number.

alt text

Reading The Date

To read the actual date you need to combine the three components.

Public Function StartDate_Get() As Date 
Dim dtReturnDate As Date
    dtReturnDate = VBA.DateSerial(Me.spnStartYear.Value, _
                                  Me.cboStartMonth.ListIndex + 1, _
                                  Me.spnStartDay.Value)
    StartDate_Get = dtReturnDate
End Function

Setting The Default Date

To set the default date you need to extract the three components from an actual date.

Public Sub StartDate_Set(ByVal dtDate As Date) 
    Me.spnStartDay.Value = VBA.Day(dtDate)
    Me.cboStartMonth.ListIndex = VBA.Month(dtDate) - 1
    Me.spnStartYear.Value = VBA.Year(dtDate)
End Sub

Add the Userform

Create a Userform
(Insert > Userform)
Caption: "VBA - DatePicker"
Resize: Height - 100, Width - 230
(View > Toolbox)


Add the Controls

Add a Label
Change the Caption to "Start Date:"
Resize: Height - 18, Width - 42
Reposition: Top - 18, Left - 6


Add a TextBox
Change the Name to "txtStartDay"
Resize: Height - 18, Width - 22
Reposition: Top - 16, Left - 48


Add a SpinButton
Change the Name to "spnStartDay"
Resize: Height - 18, Width - 12
Reposition: Top - 16, Left - 70


Add a ComboBox
Change the Name to "cboStartMonth"
Resize: Height - 18, Width - 66
Reposition: Top - 16, Left - 82


Add a TextBox
Change the Name to "txtStartYear"
Resize: Height - 18, Width - 34
Reposition: Top - 16, Left - 146


Add a SpinButton
Change the Name to "spnStartYear"
Resize: Height - 18, Width - 12
Reposition: Top - 16, Left - 180


Add a CommandButton
Change the Name to "btnSave"
Change the Caption to "Save"
Resize: Height - 24, Width - 72
Reposition: Top - 44, Left - 6


Add a Variable

At the top of the userform code module declare a variable with the data type Long.
This variable will be used to hold the date that is currently selected.
Add a private variable
Add the following code

Option Explicit 

Private m_lStartDate As Long

Add the Events

Add a UserForm_Initialise event
(View > Code) when the Userform is displayed
Change the top left drop-down to "Userform"
Change the right drop-down to "Initialize"
Add the following code

Private Sub UserForm_Initialize() 
Dim dtMyDate As Date
   Call InitialiseScatterDates
   dtMyDate = "January 1, 2024"
   Call StartDate_Set(dtMyDate)
End Sub

Add a spnStartDay_Change event
Change the top left drop-down to "spnStartDay"
Change the right drop-down to "Change"
Add the following code

Private Sub spnStartDay_Change() 
    Me.txtStartDay.Text = Me.spnStartDay.Value
    m_lStartDate = StartDate_Get
End Sub

Add a txtStartDay_Change event
Change the top left drop-down to "txtStartDay"
Change the right drop-down to "Change"
Add the following code

Private Sub txtStartDay_Change() 
    If IsNumeric(Me.txtStartDay.Value) = True Then
        If ((Me.txtStartDay.Value > 0) And (Me.txtStartDay.Value < 32)) Then
            Me.spnStartDay.Value = Me.txtStartDay.Text
        End If
    End If
    m_lStartDate = StartDate_Get
End Sub

Add a cboStartMonth_Change event
Change the top left drop-down to "cboStartMonth"
Change the right drop-down to "Change"
Add the following code

Private Sub cboStartMonth_Change() 
    m_lStartDate = StartDate_Get
End Sub

Add a spnStartYear_Change event
Change the top left drop-down to "spnStartYear"
Change the right drop-down to "Change"
Add the following code

Private Sub spnStartYear_Change() 
    Me.txtStartYear.Text = Me.spnStartYear.Value
    m_lStartDate = StartDate_Get
End Sub

Add a txtStartYear_Change event
Change the top left drop-down to "txtStartYear"
Change the right drop-down to "Change"
Add the following code

Private Sub txtStartYear_Change() 
    If IsNumeric(Me.txtStartYear.Value) = True Then
        If ((Me.txtStartYear.Value > 0) And (Me.txtStartYear.Value < 3000)) Then
            Me.spnStartYear.Value = Me.txtStartYear.Text
        End If
    End If
    m_lStartDate = StartDate_Get
End Sub

Add a btnSave_Click event
Change the top left drop-down to "btnSave"
Change the right drop-down to "Click"
Add the following code

Private Sub btnSave_Click() 
Dim dtMyDate As Date
   dtMyDate = StartDate_Get
   MsgBox Format(dtMyDate, "ddd, mmm d, yyyy")
End Sub

Add the Helper Subroutines

Underneath all the current code add the following three subroutines.
The first subroutine is to set the date that is displayed.
The second subroutines is to retrieve the date that is displayed.
The third subroutine is to initialise the controls when the userform is first loaded.

Public Sub StartDate_Set(ByVal dtDate As Date) 
    Me.spnStartDay.Value = VBA.Day(dtDate)
    Me.cboStartMonth.ListIndex = VBA.Month(dtDate) - 1
    Me.spnStartYear.Value = VBA.Year(dtDate)
End Sub

Public Function StartDate_Get() As Date
Dim dtReturnDate As Date
    dtReturnDate = VBA.DateSerial(Me.spnStartYear.Value, _
                                  Me.cboStartMonth.ListIndex + 1, _
                                  Me.spnStartDay.Value)
    StartDate_Get = dtReturnDate
End Function

Private Sub InitialiseScatterDates()
    Me.spnStartDay.Min = 1
    Me.spnStartDay.Max = 31
    Me.spnStartDay.SmallChange = 1
    Me.spnStartDay.Value = VBA.Day(VBA.Now())
    
    Me.cboStartMonth.Style = fmStyleDropDownList
    Me.cboStartMonth.ListRows = 12
    Me.cboStartMonth.ListWidth = Me.cboStartMonth.Width
    Me.cboStartMonth.ColumnWidths = Me.cboStartMonth.Width
    Me.cboStartMonth.AddItem "January"
    Me.cboStartMonth.AddItem "February"
    Me.cboStartMonth.AddItem "March"
    Me.cboStartMonth.AddItem "April"
    Me.cboStartMonth.AddItem "May"
    Me.cboStartMonth.AddItem "June"
    Me.cboStartMonth.AddItem "July"
    Me.cboStartMonth.AddItem "August"
    Me.cboStartMonth.AddItem "September"
    Me.cboStartMonth.AddItem "October"
    Me.cboStartMonth.AddItem "November"
    Me.cboStartMonth.AddItem "December"
    Me.cboStartMonth.ListIndex = VBA.Month(VBA.Now()) - 1
    
    Me.spnStartYear.Min = 1
    Me.spnStartYear.Max = 2050
    Me.spnStartYear.SmallChange = 1
    Me.spnStartYear.Value = VBA.Year(VBA.Now)
End Sub

Check that everything compiles and run the code.
(Debug > Compile Project)
Double click the Userform1 to display the Userform
Press F5 or (Run > Run Userform)
Change the date.
And Press Save to display a messagebox displaying the date that was selected.

alt text

© 2022 Better Solutions Limited. All Rights Reserved. © 2022 Better Solutions Limited TopPrevNext