Get Even More Visitors To Your Blog, Upgrade To A Business Listing >>
Idioma: En

How to Create a Date Picker Using VBA in Excel (with Easy Steps)

A date picker is one kind of dynamic calendar that allows the user to select a particular date. So, if you are looking for how to create a date picker with the help of VBA in Excel then you have come to the right place. Today, I will demonstrate how to create a date picker using VBA code in Excel.
Furthermore, for conducting the session, I will use Microsoft 365 version.

Related Articles

Download Practice Workbook

You can download the practice workbook from here:

Date Picker.xlsm

7 Easy Steps to Create Date Picker Using VBA in Excel

In this section, I will describe seven easy steps to make the date picker with VBA in Excel. Basically, you have to insert UserForm instead of using Module. So, this will be a different type of VBA. Now, let’s see the steps given below.

Step 1: Inserting UserForm to Create Calendar for Date Picker

Here, I will show you how to insert the UserForm in VBA.

  • Firstly, you need to open your worksheet. Here, you must save the Excel file as Excel Macro-Enabled Workbook (*xlsm).
  • Secondly, you have to choose the Developer tab >> then select Visual Basic.

  • At this time, from the Insert tab >> you have to select UserForm.

As a result, you will see the following output.

Step 2: Adding ComboBox for Date Picker

Now, I will add ComboBox with the help of Toolbox for making the date picker in Excel.

  • So, from the Toolbox >> Controls >> select ComboBox.
  • Then, drag the ComboBox in UserForm1.

Here is the ComboBox.

  • Similarly, drag another ComboBox just beside the previous one.

Step 3: Including Text Box for Weekdays of Calendar

At this time, I will include some Text Boxes for the naming of the days.

  • Now, from the Toolbox >> Controls >> select TextBox.
  • Then, drag the TextBox in UserForm1.

  • After that, right-click on the text >> from the Context Menu Bar >> chose Properties.

As a result, you will see the new dialog box named Properties – Label1, situated at the left-most side of the Microsoft Visual Basic Application window.

  • Then, rename the Caption as Sun.
  • Consequently, change the SpecialEffect to 1-fmSpecialEffectRaised.
  • Then, make the TextAlign to 2-fmTextAlignCenter.
  • After that, click on three dots of the Font.

So, another dialog box named Font will appear.

  • Here, you may change the font style according to your preference and press OK.

Lastly, the following is the final output.

  • Now, copy the previous text using keyboard shortcuts Ctrl+C and press 6th times Ctrl+V to paste it 6 times.
  •  Then, make their position by dragging them and change the captions to Mon, Tues, Wed, Thurs, Fri, and Sat. Below, I have attached the image.

Step 4: Inserting Command Button to Make Date Picker

Here, I need to insert the Command Button for representing the days of the month.

  • Now, from the Toolbox >> Controls >> select Command Button.
  • Then, drag the Command Button in UserForm1.

  • Then, from Properties – CommandButton1 >> remove the Caption.
  • After that, click on three dots of the Font.

As a result, another dialog box named Font will appear.

  • Now, change the font style according to your preference and press OK.

  • Then, use Excel keyboard shortcuts Ctrl+C and Ctrl+V to copy and paste the Command Button for the 34th time.

Step 5: Introducing Today’s Date for Date Picker

Now, I will introduce the present date in my calendar. Which will always be visible on the calendar.

  • First, use Step-3 to insert two new text boxes.
  • Secondly, change the caption of those boxes to Today: and Date.

  • Then, give a name to that text box containing the current date. Here, I have named as TDate.

  • After that, double-click on the Date text box.

As a result, you will see the window for keeping Code.

  • Then, choose UserForm >> Initialize >> write the following code.
Private Sub UserForm_Initialize()
Me.TDate.Caption = Date
End Sub

  • Now, run the code and you will see the following output in the worksheet.

Step 6: Naming Boxes for Running VBA Code in Excel

Here, for your better understanding to write the VBA code, I should change the name of the boxes.

  • So, I altered the name of 1st ComboBox as MnthBox1. Where there will be code for months.

  • Similarly, named the 2nd ComboBox as YrBox2. Where there will be code for years.

  • Then, keep naming the Command Buttons, I have used DBttn1 as the name of the 1st Command Button.
  • Similarly, change the name of all other Command Buttons like DBttn2, DBttn3, DBttn4, and so on. But you must maintain the sequence with the numbers. 

  • After that, add two more text boxes to keep the date that will be selected by the user.
  • Also, change the name of the 2nd one to CsnDate.

Step 7: Inserting VBA Code to Get Date Picker

Finally, in this section, I will write the code.

  • In step 5, I have written a simple code for showing the present date, there you have to include more lines. Below, I have attached the code.
Private Sub MnthBox1_Change()
If Me.MnthBox1  "" And Me.YrBox2  "" Then
Find_my_Date
End If
End Sub
Private Sub UserForm_Initialize()
Me.TDate.Caption = Date
With Me.MnthBox1
 For MnthList = 1 To 12
 .AddItem Format(DateSerial(2023, MnthList, 1), "MMMM")
 Next MnthList
 .Value = Format(Date, "MMMM")
  With Me.YrBox2
  For YrList = Year(Date) - 4 To Year(Date) + 3
  .AddItem YrList
  Next YrList
  .Value = Format(Date, "YYYY")
  End With
 End With
 Find_my_Date
End Sub
Private Sub Find_my_Date()
Initial_D = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, 1)
Final_D = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 2, 1) - 1
For ClearDBttn = 1 To 35
Me("DBttn" & ClearDBttn).Caption = ""
Next ClearDBttn
Me("DBttn" & Weekday(Initial_D)).Caption = 1
For DayDBttn = 1 To 31
If Me("DBttn" & DayDBttn).Caption  "" Then
 If Me("DBttn" & DayDBttn).Caption = Format(Final_D, "dd") Then Exit Sub
 Me("DBttn" & DayDBttn + 1).Caption = Me("DBttn" & DayDBttn).Caption + 1
 End If
  For Dis_able = 1 To 35
    If Me("DBttn" & Dis_able).Caption = "" Then
    Me("DBttn" & Dis_able).Enabled = False
    Else
    Me("DBttn" & Dis_able).Enabled = True
   End If
  Next Dis_able
 Next DayDBttn
End Sub

Code Breakdown:

  • Firstly, the 1st Private Sub Procedure named MnthBox1_Change, represents that the whole code will work when you have selected any month and year from the combo boxes.
  • Secondly, the 2nd Private Sub Procedure named UserForm_Initialize, is for keeping all the months’ names as a drop-down list in the combo box named MnthBox1, and some years in the combo box named YrBox2.
    • Furthermore, in the following portion the numerical numbers 4, and 3 denote up to which you want to see the years in the drop-down list. So, you can change as your requirement.
For YrList = Year(Date) - 4 To Year(Date) + 3
.AddItem YrList
Next YrList
    • Moreover, .Value is used for showing the selected month and year on the combo boxes.
  • Thirdly, the 3rd Private Sub Procedure named Find_my_Date, is for mentioning the days in the calendar.
    • Here, Initial_D represents the 1st day of a month.
    • Then, ClearDBttn will clear the starting date of the previous month.
    • Then, the Dis_able denotes that the empty command buttons will be unselectable.

  • Consequently, double-click on the 1st Command Button and so another sub-procedure will be open for you.
  • Now, write the following code in that sub-procedure.
Private Sub DBttn1_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn1.Caption)
End Sub

Here, this code will show you the selected date in the text box named CsnDate.

  • Then, write the same code 34 consecutive times. Here, you must change the numbers of the DBttn.

  • However, for your better understanding, I have attached the whole code below.
Private Sub DBttn1_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn1.Caption)
End Sub
Private Sub DBttn2_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn2.Caption)
End Sub
Private Sub DBttn3_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn3.Caption)
End Sub
Private Sub DBttn4_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn4.Caption)
End Sub
Private Sub DBttn5_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn5.Caption)
End Sub
Private Sub DBttn6_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn6.Caption)
End Sub
Private Sub DBttn7_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn7.Caption)
End Sub
Private Sub DBttn8_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn8.Caption)
End Sub
Private Sub DBttn9_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn9.Caption)
End Sub
Private Sub DBttn10_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn10.Caption)
End Sub
Private Sub DBttn11_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn11.Caption)
End Sub
Private Sub DBttn12_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn12.Caption)
End Sub
Private Sub DBttn13_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn13.Caption)
End Sub
Private Sub DBttn14_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn14.Caption)
End Sub
Private Sub DBttn15_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn15.Caption)
End Sub
Private Sub DBttn16_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn16.Caption)
End Sub
Private Sub DBttn17_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn17.Caption)
End Sub
Private Sub DBttn18_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn18.Caption)
End Sub
Private Sub DBttn19_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn19.Caption)
End Sub
Private Sub DBttn20_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn20.Caption)
End Sub
Private Sub DBttn21_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn21.Caption)
End Sub
Private Sub DBttn22_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn22.Caption)
End Sub
Private Sub DBttn23_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn23.Caption)
End Sub
Private Sub DBttn24_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn24.Caption)
End Sub
Private Sub DBttn25_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn25.Caption)
End Sub
Private Sub DBttn26_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn26.Caption)
End Sub
Private Sub DBttn27_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn27.Caption)
End Sub
Private Sub DBttn28_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn28.Caption)
End Sub
Private Sub DBttn29_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn29.Caption)
End Sub
Private Sub DBttn30_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn30.Caption)
End Sub
Private Sub DBttn31_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn31.Caption)
End Sub
Private Sub DBttn32_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn32.Caption)
End Sub
Private Sub DBttn33_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn33.Caption)
End Sub
Private Sub DBttn34_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn34.Caption)
End Sub
Private Sub DBttn35_Click()
Me.CsnDate.Caption = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, Me.DBttn35.Caption)
End Sub
Private Sub MnthBox1_Change()
If Me.MnthBox1  "" And Me.YrBox2  "" Then
Find_my_Date
End If
End Sub
Private Sub UserForm_Initialize()
Me.TDate.Caption = Date
With Me.MnthBox1
 For MnthList = 1 To 12
 .AddItem Format(DateSerial(2023, MnthList, 1), "MMMM")
 Next MnthList
 .Value = Format(Date, "MMMM")
  With Me.YrBox2
  For YrList = Year(Date) - 4 To Year(Date) + 3
  .AddItem YrList
  Next YrList
  .Value = Format(Date, "YYYY")
  End With
 End With
 Find_my_Date
End Sub
Private Sub Find_my_Date()
Initial_D = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 1, 1)
Final_D = DateSerial(Me.YrBox2, Me.MnthBox1.ListIndex + 2, 1) - 1
For ClearDBttn = 1 To 35
Me("DBttn" & ClearDBttn).Caption = ""
Next ClearDBttn
Me("DBttn" & Weekday(Initial_D)).Caption = 1
For DayDBttn = 1 To 31
If Me("DBttn" & DayDBttn).Caption  "" Then
 If Me("DBttn" & DayDBttn).Caption = Format(Final_D, "dd") Then Exit Sub
 Me("DBttn" & DayDBttn + 1).Caption = Me("DBttn" & DayDBttn).Caption + 1
 End If
  For Dis_able = 1 To 35
    If Me("DBttn" & Dis_able).Caption = "" Then
    Me("DBttn" & Dis_able).Enabled = False
    Else
    Me("DBttn" & Dis_able).Enabled = True
   End If
  Next Dis_able
 Next DayDBttn
End Sub

  • Finally, click on the Run button.

  • After running the code, see the worksheet and you will find the following date picker.
  • Now, select the desired month and year and choose any date, you will get that date in the Chosen Date box.

Conclusion

I hope you found this article helpful. Here, I have described 7 suitable steps for making a date picker with the help of VBA code in Excel. You can visit our website Exceldemy to learn more Excel-related content. Please, drop comments, suggestions, or queries if you have any in the comment section below.

The post How to Create a Date Picker Using VBA in Excel (with Easy Steps) appeared first on ExcelDemy.



This post first appeared on ExcelDemy.com, please read the originial post: here

Share the post

How to Create a Date Picker Using VBA in Excel (with Easy Steps)

×

Subscribe to Exceldemy.com

Get updates delivered right to your inbox!

Thank you for your subscription

×