Five functions are involved. I usually put the following in a separate
module. Assign your button to call Calendar_Main() to run it. As previously
stated, you click one time to pop the calendar up, select a date, then click
the same button again to capture the date and delete the calendar object.

I think mine runs a little differently from Ron's. The way this is set now,
it will popup a message box displaying the date selected. That is where you
would pass the date back to your calling sub. Just place all five of the
following into one standard code module. I hope you like it.

Private Sub Calendar_Main()
'MAIN CALLING PROGRAM: ADDS/RETRIEVES/DELETES CALENDAR CONTROL;
'THE FUNCTION IS RUN TWICE: ONCE TO LOAD THE CONTROL AND ONCE
'TO CAPTURE THE VALUE AND UNLOAD THE CONTROL; ON THE FIRST CALL
'NO VALUE HAS BEEN ASSIGNED YET (EXIT SUB);
Dim dteCalendarValue As Date
dteCalendarValue = CalendarPopupProgram
If UCase(dteCalendarValue) = "12:00:00 AM" Then Exit Sub
'Optionally run other procedures here - pass the date back to other routines
'instead of just displaying the date captured (as in the following line);
MsgBox Format(dteCalendarValue, "MM/DD/YYYY")
End Sub

Private Function CalendarPopupProgram() As Date
'CREATE/DELETE CALENDAR ACTIVEX CONTROL
Dim strCalendarName As String
Dim dteCalendarValue As Date
'If calendar exists: obtain the selected date and delete the calendar object
strCalendarName = CalendarGetName
If strCalendarName < "" Then
dteCalendarValue = ActiveSheet.OLEObjects(strCalendarName).Object.Val ue
ActiveSheet.Shapes(strCalendarName).Delete
CalendarPopupProgram = DateSerial(Year(dteCalendarValue),
Month(dteCalendarValue), Day(dteCalendarValue))
End If
'If calendar does not exist: create it
If strCalendarName = "" Then Call CalendarAdd
End Function

Private Function CalendarAdd()
'ADD A FORMLESS ACTIVEX CALENDAR CONTROL TO THE ACTIVE SHEET; EXIT
'DESIGN MODE FOR USER INTERFACE, CENTER THE OBJECT ON SCREEN; SET
'CALENDAR VALUE EQUAL TO TODAY'S DATE;
Application.ScreenUpdating = False
Dim objCalendar As OLEObject
Dim objWorkSheet As Worksheet
Dim varCenter() As Variant
Set objWorkSheet = Parent.ActiveSheet
Set objCalendar = objWorkSheet.OLEObjects.Add(ClassType:="MSCAL.Cale ndar",
Link:=False, DisplayAsIcon:=False)
varCenter = ScreenCenterCompact
objCalendar.Top = varCenter(1) - 72 'Adjust center of screen for 1/2
height of object to center
objCalendar.Left = varCenter(2) - 108 'Adjust center of screen for 1/2
width of object to center
objCalendar.Border.Weight = 3#
objCalendar.Border.ColorIndex = 9 '1, 9, 23, 25
objCalendar.Object.Value = Now()
objCalendar.Visible = True
objCalendar.Visible = False
Application.ScreenUpdating = True
objCalendar.Visible = True
Set objWorkSheet = Nothing
Set objCalendar = Nothing
End Function

Private Function CalendarGetName() As String
'RETURN THE NAME OF THE CALENDAR OBJECT ON THE ACTIVE
'SHEET IF ONE EXISTS; OTHERWISE RETURN EMPTY STRING;
Dim lngCount As Long
Dim lngX As Long
lngCount = ActiveSheet.Shapes.Count
If Not lngCount 0 Then CalendarGetName = "": Exit Function
For lngX = 1 To lngCount
If UCase(Left(ActiveSheet.Shapes(lngX).Name, 8)) = "CALENDAR" Then
CalendarGetName = ActiveSheet.Shapes(lngX).Name: Exit Function
Next lngX
End Function

Private Function ScreenCenterCompact() As Variant
'CALCULATE CENTER OF VISIBLE SCREEN;
Dim strVisible As String
Dim varCoordinates(2) As Variant
strVisible = Windows(1).VisibleRange.Address
varCoordinates(1) = (Range(Windows(1).VisibleRange.Cells(1, 1).Address).Top
+ (Range(Range(Windows(1).VisibleRange.Cells(1,
1).Address).Offset(Range(strVisible).Rows.Count - 1,
Range(strVisible).Columns.Count - 1).Address).Top -
Range(Windows(1).VisibleRange.Cells(1, 1).Address).Top) / 2)
varCoordinates(2) = (Range(Windows(1).VisibleRange.Cells(1, 1).Address).Left
+ (Range(Range(Windows(1).VisibleRange.Cells(1,
1).Address).Offset(Range(strVisible).Rows.Count - 1,
Range(strVisible).Columns.Count - 1).Address).Left -
Range(Windows(1).VisibleRange.Cells(1, 1).Address).Left) / 2)
ScreenCenterCompact = varCoordinates
End Function

HTH

"Create a calendar drop down box" wrote:

I would be interested in your way of creating this. What are the functions
that you use?

"quartz" wrote:

If you are interested, I have several VBA functions that work in the
following way:

1. User clicks a button on a sheet or toolbar.
2. A formless calendar appears on the sheet.
3. The user selects a date on the calendar.
4. The user clicks the button again (#1 above).
5. The program captures the date selected and deletes the calendar.

No user form is needed. It's very clean. But, as mentioned in previous
posts, you must have the control to begin with and so must all your users.

If you are interested please post back and I'll post the functions needed.

"Calendar drop down box in excel" wrote:

Does anyone know how you would create a calendar drop down box in excel?