Excel

Userform Calendar Control

Ease of Use

Intermediate

Version tested with

2000 

Submitted by:

lucas

Description:

Click on specifically formatted cells and a calendar userform pops up. Select the year and month, then click on the desired day and its entered into the cell formatted accordingly. 

Discussion:

If you use the native calendar contol from Excel and send your file to a different computer that doesn't have the same version or any calendar control installed, your calendar doesn't work and results in an error. This userform calendar control travels with the file and is readily available and easy to set up and use. 

Code:

instructions for use

			

Click on the sheet And add this code To the sheet Or sheets you wish To use the calendar on: Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'check cells for desired format to trigger the calendarfrm.show routine 'otherwise exit the sub Dim DateFormats, DF DateFormats = Array("m/d/yy;@", "mmmm d yyyy") For Each DF In DateFormats If DF = Target.NumberFormat Then If CalendarFrm.HelpLabel.Caption <> "" Then CalendarFrm.Height = 191 + CalendarFrm.HelpLabel.Height Else: CalendarFrm.Height = 191 CalendarFrm.Show End If End If Next End Sub This Is the userform code: Option Explicit Dim ThisDay As Date Dim ThisYear, ThisMth As Date Dim CreateCal As Boolean Dim i As Integer Private Sub UserForm_Initialize() Application.EnableEvents = False 'starts the form on todays date ThisDay = Date ThisMth = Format(ThisDay, "mm") ThisYear = Format(ThisDay, "yyyy") For i = 1 To 12 CB_Mth.AddItem Format(DateSerial(Year(Date), Month(Date) + i, 0), "mmmm") Next CB_Mth.ListIndex = Format(Date, "mm") - Format(Date, "mm") For i = -20 To 50 If i = 1 Then CB_Yr.AddItem Format((ThisDay), "yyyy") Else CB_Yr.AddItem _ Format((DateAdd("yyyy", (i - 1), ThisDay)), "yyyy") Next CB_Yr.ListIndex = 21 'Builds the calendar with todays date CreateCal = True Call Build_Calendar Application.EnableEvents = True End Sub Private Sub CB_Mth_Change() 'rebuilds the calendar when the month is changed by the user Build_Calendar End Sub Private Sub CB_Yr_Change() 'rebuilds the calendar when the year is changed by the user Build_Calendar End Sub Private Sub Build_Calendar() 'the routine that actually builds the calendar each time If CreateCal = True Then CalendarFrm.Caption = " " & CB_Mth.Value & " " & CB_Yr.Value 'sets the focus for the todays date button CommandButton1.SetFocus For i = 1 To 42 If i < Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _ ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d") Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _ ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") ElseIf i >= Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) _ & "/1/" & (CB_Yr.Value))), ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d") Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _ ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") End If If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _ ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "mmmm") = ((CB_Mth.Value)) Then If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H80000018 '&H80000010 Controls("D" & (i)).Font.Bold = True If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _ ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") = Format(ThisDay, "m/d/yy") Then Controls("D" & (i)).SetFocus Else If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H8000000F Controls("D" & (i)).Font.Bold = False End If Next End If End Sub Private Sub D1_Click() 'this sub and the ones following represent the buttons for days on the form 'retrieves the current value of the individual controltiptext and 'places it in the active cell ActiveCell.Value = D1.ControlTipText Unload Me 'after unload you can call a different userform to continue data entry 'uncomment this line and add a userform named UserForm2 'Userform2.Show End Sub Private Sub D2_Click() ActiveCell.Value = D2.ControlTipText Unload Me End Sub Private Sub D3_Click() ActiveCell.Value = D3.ControlTipText Unload Me End Sub Private Sub D4_Click() ActiveCell.Value = D4.ControlTipText Unload Me End Sub Private Sub D5_Click() ActiveCell.Value = D5.ControlTipText Unload Me End Sub Private Sub D6_Click() ActiveCell.Value = D6.ControlTipText Unload Me End Sub Private Sub D7_Click() ActiveCell.Value = D7.ControlTipText Unload Me End Sub Private Sub D8_Click() ActiveCell.Value = D8.ControlTipText Unload Me End Sub Private Sub D9_Click() ActiveCell.Value = D9.ControlTipText Unload Me End Sub Private Sub D10_Click() ActiveCell.Value = D10.ControlTipText Unload Me End Sub Private Sub D11_Click() ActiveCell.Value = D11.ControlTipText Unload Me End Sub Private Sub D12_Click() ActiveCell.Value = D12.ControlTipText Unload Me End Sub Private Sub D13_Click() ActiveCell.Value = D13.ControlTipText Unload Me End Sub Private Sub D14_Click() ActiveCell.Value = D14.ControlTipText Unload Me End Sub Private Sub D15_Click() ActiveCell.Value = D15.ControlTipText Unload Me End Sub Private Sub D16_Click() ActiveCell.Value = D16.ControlTipText Unload Me End Sub Private Sub D17_Click() ActiveCell.Value = D17.ControlTipText Unload Me End Sub Private Sub D18_Click() ActiveCell.Value = D18.ControlTipText Unload Me End Sub Private Sub D19_Click() ActiveCell.Value = D19.ControlTipText Unload Me End Sub Private Sub D20_Click() ActiveCell.Value = D20.ControlTipText Unload Me End Sub Private Sub D21_Click() ActiveCell.Value = D21.ControlTipText Unload Me End Sub Private Sub D22_Click() ActiveCell.Value = D22.ControlTipText Unload Me End Sub Private Sub D23_Click() ActiveCell.Value = D23.ControlTipText Unload Me End Sub Private Sub D24_Click() ActiveCell.Value = D24.ControlTipText Unload Me End Sub Private Sub D25_Click() ActiveCell.Value = D25.ControlTipText Unload Me End Sub Private Sub D26_Click() ActiveCell.Value = D26.ControlTipText Unload Me End Sub Private Sub D27_Click() ActiveCell.Value = D27.ControlTipText Unload Me End Sub Private Sub D28_Click() ActiveCell.Value = D28.ControlTipText Unload Me End Sub Private Sub D29_Click() ActiveCell.Value = D29.ControlTipText Unload Me End Sub Private Sub D30_Click() ActiveCell.Value = D30.ControlTipText Unload Me End Sub Private Sub D31_Click() ActiveCell.Value = D31.ControlTipText Unload Me End Sub Private Sub D32_Click() ActiveCell.Value = D32.ControlTipText Unload Me End Sub Private Sub D33_Click() ActiveCell.Value = D33.ControlTipText Unload Me End Sub Private Sub D34_Click() ActiveCell.Value = D34.ControlTipText Unload Me End Sub Private Sub D35_Click() ActiveCell.Value = D35.ControlTipText Unload Me End Sub Private Sub D36_Click() ActiveCell.Value = D36.ControlTipText Unload Me End Sub Private Sub D37_Click() ActiveCell.Value = D37.ControlTipText Unload Me End Sub Private Sub D38_Click() ActiveCell.Value = D38.ControlTipText Unload Me End Sub Private Sub D39_Click() ActiveCell.Value = D39.ControlTipText Unload Me End Sub Private Sub D40_Click() ActiveCell.Value = D40.ControlTipText Unload Me End Sub Private Sub D41_Click() ActiveCell.Value = D41.ControlTipText Unload Me End Sub Private Sub D42_Click() ActiveCell.Value = D42.ControlTipText Unload Me End Sub

How to use:

  1. Open the VBE and add the code above to the appropriate objects, close the vbe and format the cells you wish to use as shown above and save your changes.
  2. You could easily create your own userform or customize the one in the example file. All you need to do is use the custom formats in the cells you wish to click on to run the calendar control.
  3. Custom format for the cells is: m/d/yy;@ results in a date like: 7/5/05
  4. Custom format for the cells is: mmmm d yyyy results in a date like: July 5, 2005
  5. remember the sheet you use this on must have the sheet code from above added to its codesheet.
 

Test the code:

  1. Click on one of the formatted cells and your calendar control will open for you to select a date to enter into the sheet.
 

Sample File:

click cell-popup calendar.zip 21.71KB 

Approved by mdmackillop


This entry has been viewed 588 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2014 VBA Express