Rudimentary Calendar

' ***********************  this is the userform code  *********************
Option Explicit

' for sharing 1 click event for each of the command buttons
Private Type TLocals
    AllControls()  As New UsfControlEvents
End Type
Private this As TLocals

Dim formIsLoading As Boolean
Public selectedDate As Date

Private Sub CreateEventHandlers()

    ' date button click event
    Dim ctrl As MSForms.Control, ControlCount As Long

    For Each ctrl In Me.Controls
        ' the command button names weren't changed so it was easy to find them on the form
        ' any other command button used will not have command button in it's name
        If InStr(ctrl.Name, "CommandButton") > 0 Then
            ControlCount = ControlCount + 1
            ReDim Preserve this.AllControls(1 To ControlCount)
            With this.AllControls(ControlCount)
                Set .CmdBttnGroup = ctrl
                .Init argHostUsf:=Me
            End With
        End If
    Next ctrl

End Sub


Private Function GetButton(buttonName) As MSForms.CommandButton

    ' get the button asked for
    Dim ctrl As Control
    Dim foundButton As MSForms.CommandButton

    For Each ctrl In frmCalendar.Controls

        If ctrl.Name = buttonName Then
            Set foundButton = ctrl
            Exit For
        End If

    Next ctrl

    Set GetButton = foundButton

End Function

Private Sub HideButtons()

    ' reset the visibility of the buttons used as dates
    Dim ctrl As Control

    For Each ctrl In frmCalendar.Controls
        If InStr(ctrl.Name, "Command") > 0 Then ctrl.Visible = False
    Next ctrl

End Sub

Private Sub SelectMonthYear()

    drpMonth.ListIndex = Month(Date) - 1 ' select the current month

    ' select the current year
    Dim idx As Integer
    For idx = 0 To drpYear.ListCount - 1
        drpYear.ListIndex = idx
        If drpYear.Text = Year(Date) Then Exit For

    Next idx

End Sub

Private Sub FillCalendar(theMonth As Integer, theYear As Integer)

    ' fill the form with the selected month and year
    Dim dayNumber As Integer
    Dim firstDayNextMonth As Date
    Dim firstDayThisMonth As Date
    Dim lastDayThisMonth As Date
    Dim buttonName As String
    Dim buttonNumber As Integer
    Dim dayButton As MSForms.CommandButton

    ' calc the first and last days of the month
    firstDayThisMonth = CDate(theMonth & "/1/" & theYear)

    firstDayNextMonth = DateAdd("m", 1, firstDayThisMonth)

    lastDayThisMonth = firstDayNextMonth - 1

    buttonNumber = Weekday(firstDayThisMonth) ' assign the button number to start with

    dayNumber = 1
    Do While True
        buttonName = "CommandButton" & buttonNumber

        Set dayButton = GetButton(buttonName)
        dayButton.Caption = dayNumber
        dayButton.Visible = True
        dayButton.BackColor = Me.BackColor  ' reset the color of button as "not selected"

        ' if true the current days date will have a bold font
        If CDate(drpMonth.Text & " " & dayNumber & ", " & drpYear.Text) = Date Then
            dayButton.ForeColor = vbBlue
        Else
            dayButton.ForeColor = vbBlack
        End If

        ' when we reach the last day of the month exit this loop
        If dayNumber = Day(lastDayThisMonth) Then Exit Do

        ' increment the day number and the button number it should be placed on
        dayNumber = dayNumber + 1
        buttonNumber = buttonNumber + 1

    Loop

    ' write the current month year being displayed
    Me.Tag = theMonth & "|" & theYear

End Sub

Private Sub FillMonthDropDown()

    ' fill the month dropdown
    drpMonth.List = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")

End Sub

Private Sub FillYearCombo()

    ' fill the year combobox
    drpYear.List = Array(Year(Date) - 1, Year(Date), Year(Date) + 1, Year(Date) + 2, Year(Date) + 3, Year(Date) + 5, Year(Date) + 5)

End Sub

Private Sub HighlightDateButton(dateToHighlight As Date)

End Sub

Private Sub btnOK_Click()
    ' close the form
    Me.Hide

End Sub

Private Sub drpMonth_Click()
    ' update the calendar to display the selected month, there has to be a year
    If Not formIsLoading Then
        HideButtons
        FillCalendar drpMonth.ListIndex + 1, drpYear.Text
    End If

End Sub

Private Sub drpYear_Click()
        ' update the calendar to display the selected month, there has to be a year
    If Not formIsLoading Then
        HideButtons
        FillCalendar drpMonth.ListIndex + 1, drpYear.Text
    End If

End Sub

Private Sub UserForm_Initialize()

    ' fill the form with the current month and highlight today
    formIsLoading = True

    FillMonthDropDown
    FillYearCombo
    SelectMonthYear

    FillCalendar Month(Date), Year(Date)

    formIsLoading = False

    ' assign each of the day buttons the same event handler
    CreateEventHandlers

End Sub

Private Sub UserForm_Terminate()

End Sub


' *************************  Module1 UDF
Public Function AskForDate() As Date

    Dim dateSelected As Date

    frmCalendar.Show vbModal
    dateSelected = frmCalendar.selectedDate

    Unload frmCalendar

    AskForDate = dateSelected
End Function


' ******************** User Class to hold the shared CommandButton click event
' create an event that all the buttons use
' from https://www.mrexcel.com/board/threads/how-to-reference-a-userform-command-button-click-event-when-the-button-was-created-dynamically.1189029/

Public WithEvents CmdBttnGroup As MSForms.CommandButton

Private Type TLocals
    Usf As Object
End Type
Private this As TLocals

Public Sub Init(ByVal argHostUsf As Object)
    Set this.Usf = argHostUsf
End Sub

Private Sub CmdBttnGroup_Click()

    ' indicate the selected date and assign it to the public
    CmdBttnGroup.BackColor = vbYellow
    Dim parentForm As frmCalendar
    Set parentForm = CmdBttnGroup.Parent

    parentForm.selectedDate = CDate(parentForm.drpMonth.ListIndex + 1 & "/" & CmdBttnGroup.Caption & "/" & parentForm.drpYear.Text)
    Set parentForm = Nothing

End Sub


' ******************************  worksheet code
Private Sub CommandButton1_Click()
    ' direct call to a cell
    Sheet1.Cells(2, 2).Value = AskForDate()

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' if the user clicks into a cell on col B allow them to pick a date
    ' ignore the header and the row with a button that lets the user select a date
    If Target.Column = 2 And Target.Row > 2 Then
        ' the user clicked into the column requiring a date
        Sheet1.Cells(Target.Row, 2).Value = AskForDate()

    End If

End Sub