Excel VBA - calendar date pick up: problem with code

[MEGSS]

Hi guys,

I am new to VBA and I need some help please.

I created a calendar in vba using different sources that I found online.

It I supposed to pop up in two cells on my Excel spreadsheet when I Click on those cells, and it does.
The problem is that when I click on any date, it will not fill the selected date in the Excel worksheet cell. So I guess the code for this specific action is wrong.

Here is what I have done so far: I created a form with multiple labels (contain the days of the week) and 2 image controls, one to contain the left icon to scroll previous months and one to scroll next month.

This s the code on the form:

Option Explicit
Private curMonth As Date

Private Function FirstCalSun(ref_date As Date) As Date
  
    FirstCalSun = DateSerial(Year(ref_date), _
                  Month(ref_date), 1) - (Weekday(ref_date) - 1)
End Function
Private Sub Build_Calendar(first_sunday As Date)
    Dim lDate As MSForms.Label
    Dim i As Integer, a_date As Date
    For i = 1 To 42
        a_date = first_sunday + (i - 1)
        Set lDate = Me.Controls("Label_" & Format(i, "00"))
        lDate.Caption = Day(a_date)
        If Month(a_date) <> Month(curMonth) Then
            lDate.ForeColor = &H80000011
        Else
            If Weekday(a_date) = 1 Then
                lDate.ForeColor = &HC0&
            Else
                lDate.ForeColor = &H80000012
            End If
        End If
    Next
End Sub
Private Sub select_label(msForm_C As MSForms.Control)
    Dim i As Integer, sel_date As Date
    i = Split(msForm_C.Name, "_")(1) - 1
    sel_date = FirstCalSun(curMonth) + i
    
    MsgBox sel_date
End Sub
Sub ExplicitSelectCell()
Sheets("Sheet1").Activate
ActiveSheet.Range("E2", "F2").Select
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
On Error Resume Next
ActiveCell.Value = DateClicked
  
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub Image_Left_Click()
    If Month(curMonth) = 1 Then
        curMonth = DateSerial(Year(curMonth) - 1, 12, 1)
    Else
        curMonth = DateSerial(Year(curMonth), Month(curMonth) - 1, 1)
    End If
    With Me
        .Label_MthYr.Caption = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With
End Sub
Private Sub Image_Right_Click()
 If Month(curMonth) = 12 Then
        curMonth = DateSerial(Year(curMonth) + 1, 1, 1)
    Else
        curMonth = DateSerial(Year(curMonth), Month(curMonth) + 1, 1)
    End If
    With Me
        .Label_MthYr.Caption = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With
End Sub
Private Sub Image_Left_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                                 ByVal X As Single, ByVal Y As Single)
    Me.Image_Left.BorderStyle = fmBorderStyleSingle
End Sub
Private Sub Image_Left_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Image_Left.BorderStyle = fmBorderStyleNone
End Sub
Private Sub Image_Right_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                                 ByVal X As Single, ByVal Y As Single)
    Me.Image_Right.BorderStyle = fmBorderStyleSingle
End Sub
Private Sub Image_Right_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Image_Right.BorderStyle = fmBorderStyleNone
End Sub
Private Sub Label_01_Click()
    select_label Me.Label_01
End Sub
Private Sub Label_02_Click()
    select_label Me.Label_02
End Sub
Private Sub Label_03_Click()
    select_label Me.Label_03
End Sub
Private Sub Label_04_Click()
    select_label Me.Label_04
End Sub
Private Sub Label_05_Click()
    select_label Me.Label_05
End Sub
Private Sub Label_06_Click()
    select_label Me.Label_06
End Sub
Private Sub Label_07_Click()
    select_label Me.Label_07
End Sub
Private Sub Label_08_Click()
    select_label Me.Label_08
End Sub
Private Sub Label_09_Click()
    select_label Me.Label_09
End Sub
Private Sub Label_10_Click()
    select_label Me.Label_10
End Sub
Private Sub Label_11_Click()
    select_label Me.Label_11
End Sub
Private Sub Label_12_Click()
    select_label Me.Label_12
End Sub
Private Sub Label_13_Click()
    select_label Me.Label_13
End Sub
Private Sub Label_14_Click()
    select_label Me.Label_14
End Sub
Private Sub Label_15_Click()
    select_label Me.Label_15
End Sub
Private Sub Label_16_Click()
    select_label Me.Label_16
End Sub
Private Sub Label_17_Click()
    select_label Me.Label_17
End Sub
Private Sub Label_18_Click()
    select_label Me.Label_18
End Sub
Private Sub Label_19_Click()
    select_label Me.Label_19
End Sub
Private Sub Label_20_Click()
    select_label Me.Label_20
End Sub
Private Sub Label_21_Click()
    select_label Me.Label_21
End Sub
Private Sub Label_22_Click()
    select_label Me.Label_22
End Sub
Private Sub Label_23_Click()
    select_label Me.Label_23
End Sub
Private Sub Label_24_Click()
    select_label Me.Label_24
End Sub
Private Sub Label_25_Click()
    select_label Me.Label_25
End Sub
Private Sub Label_26_Click()
    select_label Me.Label_26
End Sub
Private Sub Label_27_Click()
    select_label Me.Label_27
End Sub
Private Sub Label_28_Click()
    select_label Me.Label_28
End Sub
Private Sub Label_29_Click()
    select_label Me.Label_29
End Sub
Private Sub Label_30_Click()
    select_label Me.Label_30
End Sub
Private Sub Label_31_Click()
    select_label Me.Label_31
End Sub
Private Sub Label_32_Click()
    select_label Me.Label_32
End Sub
Private Sub Label_33_Click()
    select_label Me.Label_33
End Sub
Private Sub Label_34_Click()
    select_label Me.Label_34
End Sub
Private Sub Label_35_Click()
    select_label Me.Label_35
End Sub
Private Sub Label_36_Click()
    select_label Me.Label_36
End Sub
Private Sub Label_37_Click()
    select_label Me.Label_37
End Sub
Private Sub Label_38_Click()
    select_label Me.Label_38
End Sub
Private Sub Label_39_Click()
    select_label Me.Label_39
End Sub
Private Sub Label_40_Click()
    select_label Me.Label_40
End Sub
Private Sub Label_41_Click()
    select_label Me.Label_41
End Sub
Private Sub Label_42_Click()
    select_label Me.Label_42
End Sub
Private Sub Label_01_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BorderStyle = fmBorderStyleSingle
End Sub
Private Sub Label_01_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BackColor = &H8000000B
End Sub
Private Sub Label_01_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                             ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BorderStyle = fmBorderStyleNone
End Sub

Private Sub UserForm_Initialize()
    With Me
        curMonth = DateSerial(Year(Date), Month(Date), 1)
        .Label_MthYr = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    With Me
        Dim ctl As MSForms.Control, lb As MSForms.Label
        For Each ctl In .Controls
            If ctl.Tag = "dts" Then
                Set lb = ctl: lb.BackColor = &H80000005
            End If
        Next
    End With
End Sub

This is the code that is wrong:

Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
On Error Resume Next

ActiveCell.Value = DateClicked
  
End Sub

And this is the code to show my calendar in cells E2 and F2 of my worksheet only.

Private Sub worksheet_selectionchange(ByVal target As Range)
If Not Application.Intersect(Range("E2"), target) Is Nothing Then
MyCalendar.Show
End If
If Not Application.Intersect(Range("F2"), target) Is Nothing Then
MyCalendar.Show
End If
End Sub

Thank you!

 

[Jeffrey Mahoney]

My first thought on this is that the SUB MonthView1_DateClick doesn't get called from anywhere. You should create a breakpoint in that SUB and debug the code to see if it gets called at all; and if it does, find out if DateClicked has any value.

I use a couple different calendars similar to this. I would need the Form to test it fully.

Jeff

 

[MEGSS]

Thank you, Jeff.
I did the debug and yes, the code doesn't get called at all and I do not know how to do it.
If it helps I could post the link where I got the form and the code from.

 

[MEGSS]

Everything works fine, the calendar only pops up when I click on these two cells only. So, when I click on E2, the calendar pops up, I select a date, then a message box with the selected date pops up, I click ok to close it, then I close the calendar, but the date I clicked on will not be inserted in my E2 cell.

I guess I need a code in the select_label procedure below which will make the date I click on in the calendar and pops up in the MsgBox fill my excel E2 or F2 cells.

<code> Private Sub select_label(msForm_C As MSForms.Control)
'/* Capture the selected date */
Dim i As Integer, sel_date As Date
i = Split(msForm_C.Name, "_")(1) - 1
sel_date = FirstCalSun(curMonth) + i

'/* Transfer the date where you want it to go */
MsgBox sel_date

End Sub</code>

 

[Jeffrey Mahoney]

There must be a control on the form that selects the date and continues; like an OK button or something. I had an OK button, but I also tested if the end user double clicked a date. Either one of those would call your SUB MonthView1_DateClick.

Jeff