popup calendar when clicking on cell in userform

Hello Spritz,

I understand the code you have posted here. But, there are a few questions I have about your setup that will be answered more quickly and easily by seeing the workbook. Can you post the workbook?

Hello Spritz,

Seems like everything breaks at once. Both my truck and my daughter's broke down. I have been juggling schedules with one car to get her to work and back plus deal with the repair shops. Anyway, the attached workbook has a new Calendar. I wrote this a few years ago because I had the same problem you did. This Calendar form will let you select the object the date is to be displayed in. The object must have a Value property for this to work. The reason is most objects have a Value property. There are a few with Captions, TextFrames, etc. That will be an update for a later time.

The attached workbook has these modules and changes added.
Here is a sample of the changes I made to your TextBox code. You can see there is far less code now.

Private Sub LI1_Enter()
    Dim D1 As Date
        Call frmCalendar.DisplayIn(LI1)
        If LI1.Value = "" Then Exit Sub
        D1 = DateAdd("m", 6, LI1.Value)
        Textbox6.Value = Format(D1, "Medium Date")
End Sub

DateBtnEvents - Class Module for the Calendar Date Buttons

'Written: February 15, 2011
'Author:  Leith Ross
'
'NOTE:  This Class is used with the Form frmCalendar.
'       The property DateGoesTo assigns the object
'       used to display the chosen date.
'
'       You must declare the variable DisplayDateObject
'       As Public in a Module within this VB Project.
'       The variable holds the object used to display the
'       Calendar Date. The Object must have a Value property.


Private pvtDisplayObject    As Object
Private pvtParent           As Object


Public WithEvents EventHandler As MSForms.CommandButton


Private Sub EventHandler_Click()
    If EventHandler.Enabled = False Then Exit Sub
    pvtDisplayObject.Value = EventHandler.ControlTipText
End Sub

Public Property Set SendDateTo(ByRef Display_Object As Object)
    Set pvtDisplayObject = Display_Object
End Property

Public Property Set Parent(ByRef Parent_Object As Object)
    If pvtParent Is Nothing Then
        Set pvtParent = Parent_Object
    Else
        MsgBox "This property is Read Only.", vbExclamation
    End If
End Property

Public Property Get SendDateTo() As Object
    Set SendDateTo = pvtDisplayObject
End Property

Public Property Get Parent() As Object
    Set Parent = pvtParent
End Property

Code for the Calendar Form

'Written: January 11, 2011
'Updated: February 15, 2011
'Author:  Leith Ross (www.excelforum.com)

Option Explicit

Dim BtnArray(1 To 42) As Object


Sub DisplayIn(Optional ByRef Display_Object As Object)
    
    ' This sub can be called without having to first load the Calendar. It assigns
    ' an object that will be used to display the Calendar date and then displays
    ' the Calendar itself. The default display object is the ActiveCell.
    '
    ' NOTE: The object used to display the date must have a Value Property.
    
    
    Dim i As Long
    
        Set DisplayDateObject = Display_Object
        
            For i = 1 To 42
                Set BtnArray(i).SendDateTo = DisplayDateObject
            Next i
        
        Me.Show
        
End Sub

Sub ShowDays()

    Dim FirstDay    As Long
    Dim i           As Long
    Dim LastDay     As Long
    Dim M           As Integer
    Dim N           As Integer
    Dim y           As Integer
  
        y = CLng(cboYear.Value)
        M = cboMonth.ListIndex + 1
        
        FirstDay = DateSerial(y, M, 1)
        LastDay = DateSerial(y, M + 1, 1) - 1&
    
        For i = FirstDay - (Weekday(FirstDay) - 1) To LastDay + (42 - (LastDay - FirstDay) - Weekday(FirstDay))
            N = N + 1
            With Controls("D" & N)
                .Caption = Format(i, "d")
                .ControlTipText = Format(i, "Medium Date")
                .Tag = .ControlTipText
                If i < FirstDay Or i > LastDay Then
                    .BackColor = vbButtonFace
                    .Enabled = False
                Else
                    .BackColor = vbInfoBackground
                    .Enabled = True
                    If Weekday(i) = 1 Or Weekday(i) = 7 Then
                        .ForeColor = vbRed
                    Else
                        .ForeColor = vbButtonText
                    End If
                End If
                If i = Fix(Now()) Then .BackColor = vbGreen
            End With
        Next i
     
End Sub


Private Sub cboMonth_Change()
    ShowDays
End Sub

Private Sub cboYear_Click()
    ShowDays
End Sub

Private Sub UserForm_Initialize()

    Dim i           As Long
    Dim YearEnd     As Long
    Dim YearStart   As Long
    
        ' BEFORE RUNNING THIS FORM...
        ' 1. Add the Class module DateBtnEvents
        ' 2. Declare the variable DisplayDateObject
        '    As Public in a Module within this VB Project.
        '    The variable holds the object used to display the
        '    Calendar Date. The Object must have a Value property.
    
        YearStart = 1900
        YearEnd = 2100

            For i = 2 To 372 Step 31
                cboMonth.AddItem Format(i, "mmmm")
            Next i

            For i = YearStart To YearEnd
                cboYear.AddItem CStr(i)
            Next i
    
            cboYear.Value = Format(Now(), "yyyy")
            cboMonth.Value = Format(Now(), "mmmm")
                                                                                                                                                                               
        If DisplayDateObject Is Nothing Then
            Set DisplayDateObject = ActiveCell
        End If
        
        For i = 1 To 42
            Set BtnArray(i) = New DateBtnEvents
            Set BtnArray(i).Parent = Me.Controls("D" & i)
            Set BtnArray(i).EventHandler = Me.Controls("D" & i)
            Set BtnArray(i).SendDateTo = DisplayDateObject
        Next i
    
End Sub

Hello Spritz,

My luck with autos is bad. Thanks for the condolences. Glad to hear you like the changes.