VBA UserForm Calendar Date Picker

[Happy Coder]

I have a calendar titled frmCalendar and it works fine. However, I need the image to link from frmcalendar to the IMGCalDAccept1 to add the date to txtDAccept, IMGCalDOB to add the date to txtDOB , IMGCalRefDate to add the date to txtRefSJ, IMGCalDSeenMem to add the date to txtDSeenMem, IMGCalDDischarge to add the date to txtDDischarge, and IMGDCancerDx to add the date to txtDateCancerDx. The dates should populate in the AffiliateUF userform textboxes listed above, when the images are clicked on.

Here is my code. The calendar shows and I can click on the buttons but the date doesn't appear in the textboxes.
Private Sub IMGCalDAccept1_Click()
' Set the selectedTextBox to the corresponding TextBox for Date of Accept
Set selectedTextBox = Me.txtDAccept

' Open the calendar form
frmCalendar.Show
End Sub

 

[MikeVol]

Hello @Happy Coder, Maybe...

Private Sub IMGCalDAccept1_Click()
    ' Set the selectedTextBox to the corresponding TextBox for Date of Accept
    Set selectedTextBox = AffiliateUF.txtDAccept

    ' Open the calendar form
    frmCalendar.Show
End Sub

 

[Happy Coder]

Private Sub IMGCalDAccept1_Click() ' Set the selectedTextBox to the corresponding TextBox for Date of Accept Set selectedTextBox = AffiliateUF.txtDAccept ' Open the calendar form frmCalendar.Show End Sub

The calendar appears but not adding the date to the textbox in the userform.

 

[Happy Coder]

The calendar appears but not adding the date to the textbox in the userform.

Here is the code in the Affiliate userform.

Private Sub IMGCAL_Click()
' Check if the active control is one of the specified textboxes
If ActiveControl Is txtDAccept Or ActiveControl Is txtDOB Or _
ActiveControl Is txtRefSJ Or ActiveControl Is txtDSeenMem Or _
ActiveControl Is txtDateCancerDx Or ActiveControl Is txtDDischarge Then

' Set the TargetTextBox in frmCalendar to the active control
Set frmCalendar.targetTextBox = ActiveControl
Else
' If the active control is not one of the specified textboxes, set TargetTextBox to Nothing
Set frmCalendar.targetTextBox = Nothing
End If

' Show the frmCalendar form
frmCalendar.Show
End Sub


Public targetTextBox As MSForms.TextBox
Public targetForm As Object
'THIS CODE IS NO LONGER USED. I CHANGED THE NAME TO THE ONE BELOW.
'Private Sub IMGCalDAccept1_Click()
' Set frmCalendar.targetTextBox = Me.txtDAccept
' frmCalendar.Show
'End Sub
Private Sub IMGCalDAccept_Click()
' Set the selectedTextBox to the corresponding TextBox for Date of Accept
Set selectedTextBox = AffiliateUF.txtDAccept

' Open the calendar form
frmCalendar.Show
End Sub

Private Sub IMGCalDOB_Click()
Set frmCalendar.targetTextBox = Me.txtDOB
frmCalendar.Show
End Sub


Private Sub IMGCalRefDate_Click()
Set frmCalendar.targetTextBox = Me.txtRefSJ
frmCalendar.Show
End Sub

Private Sub IMGCalDSeenMem_Click()
Set frmCalendar.targetTextBox = Me.txtDSeenMem
frmCalendar.Show
End Sub

Private Sub IMGCalDDischarge_Click()
Set frmCalendar.targetTextBox = Me.txtDDischarge
frmCalendar.Show
End Sub

Private Sub IMGDCancerDx_Click()
Set frmCalendar.targetTextBox = Me.txtDateCancerDx
frmCalendar.Show
End Sub

 

[Happy Coder]

The calendar appears but not adding the date to the textbox in the userform.

Hello @Happy Coder, Maybe...

Private Sub IMGCalDAccept1_Click()
    ' Set the selectedTextBox to the corresponding TextBox for Date of Accept
    Set selectedTextBox = AffiliateUF.txtDAccept

    ' Open the calendar form
    frmCalendar.Show
End Sub

Here is the calendar code.
Public targetTextBox As MSForms.TextBox


Private Sub BtnDay_Click()
If Not targetTextBox Is Nothing Then
' Construct the full date based on selected day, current month, and year
Dim selectedDate As Date
selectedDate = DateSerial(CInt(lblYear.Caption), MonthNumber(lblMonth.Caption), CInt(Me.ActiveControl.Caption))

' Assign the formatted date to the target textbox
targetTextBox.Value = Format(selectedDate, "mm/dd/yy")

' Close the calendar
Unload Me
Else
MsgBox "No target textbox set!", vbExclamation
End If
End Sub





Private Sub UserForm_Initialize()
' Default to the current month and year
lblMonth.Caption = Format(Date, "MMMM") ' Full month name (e.g., "March")
lblYear.Caption = Year(Date) ' Current year

' Initialize the calendar view with days of the current month
UpdateCalendar
End Sub

Private Sub btnPrevMonth_Click()
Dim currentMonth As Integer
Dim currentYear As Integer
Dim newDate As Date

' Get current month and year
currentMonth = Month(DateValue("1 " & lblMonth.Caption & " " & lblYear.Caption))
currentYear = CInt(lblYear.Caption)

' Decrement the month
If currentMonth = 1 Then
currentMonth = 12
currentYear = currentYear - 1
Else
currentMonth = currentMonth - 1
End If

' Update labels
lblMonth.Caption = monthName(currentMonth)
lblYear.Caption = currentYear

' Refresh calendar display
UpdateCalendar
End Sub

Private Sub btnNextMonth_Click()
Dim currentMonth As Integer
Dim currentYear As Integer
Dim newDate As Date

Dim monthText As String
Dim yearText As String

monthText = lblMonth.Caption
yearText = lblYear.Caption

' Validate month and year before converting
If monthText = "" Or yearText = "" Then Exit Sub ' Prevent errors if labels are empty

' Validate that year is numeric
If Not IsNumeric(yearText) Then Exit Sub

' Convert month name to number safely
currentMonth = MonthNumber(monthText)
currentYear = Val(yearText)

If currentMonth = 0 Or currentYear < 1900 Then Exit Sub ' Ensure valid values

currentYear = CInt(lblYear.Caption)

' Increment the month
If currentMonth = 12 Then
currentMonth = 1
currentYear = currentYear + 1
Else
currentMonth = currentMonth + 1
End If

' Update labels
lblMonth.Caption = monthName(currentMonth)
lblYear.Caption = currentYear

' Refresh calendar display
UpdateCalendar
End Sub

Private Sub UpdateCalendar()
Dim firstDay As Integer, totalDays As Integer
Dim i As Integer, startIndex As Integer
Dim currentMonth As Integer, currentYear As Integer
Dim currentDate As Date

' Ensure lblMonth and lblYear contain valid data
If lblMonth.Caption = "" Or lblYear.Caption = "" Then Exit Sub
If Not IsNumeric(lblYear.Caption) Then Exit Sub

' Get current month and year
currentMonth = MonthNumber(lblMonth.Caption)
currentYear = CInt(lblYear.Caption)

' Get first day of the month (1 = Sunday, 7 = Saturday)
currentDate = DateSerial(currentYear, currentMonth, 1)
firstDay = Weekday(currentDate, vbSunday) ' Adjusted for Sunday start

' Get the total number of days in the current month
totalDays = Day(DateSerial(currentYear, currentMonth + 1, 0))

' Determine where the first day of the month should start in btnDay1-42
startIndex = firstDay ' Since btnDay1 starts on a Sunday, no need for adjustments

' Reset all buttons
For i = 1 To 42
With Me.Controls("btnDay" & i)
.Caption = ""
.Visible = False
End With
Next i

' Populate the calendar with actual dates
For i = 1 To totalDays
With Me.Controls("btnDay" & (startIndex + i - 1))
.Caption = i
.Visible = True
End With
Next i
End Sub

Private Function MonthNumber(monthName As String) As Integer
Dim monthList As Variant
monthList = Array("January", "February", "March", "April", "May", "June", _
"July", "August", "September", "October", "November", "December")

Dim i As Integer
For i = LBound(monthList) To UBound(monthList)
If monthList(i) = monthName Then
MonthNumber = i + 1
Exit Function
End If
Next i

MonthNumber = 0 ' Return 0 if no match (prevents errors)
End Function

 

[Happy Coder]

Here is the calendar code.
Public targetTextBox As MSForms.TextBox


Private Sub BtnDay_Click()
If Not targetTextBox Is Nothing Then
' Construct the full date based on selected day, current month, and year
Dim selectedDate As Date
selectedDate = DateSerial(CInt(lblYear.Caption), MonthNumber(lblMonth.Caption), CInt(Me.ActiveControl.Caption))

' Assign the formatted date to the target textbox
targetTextBox.Value = Format(selectedDate, "mm/dd/yy")

' Close the calendar
Unload Me

Here is the calendar code.
Public targetTextBox As MSForms.TextBox


Private Sub BtnDay_Click()
If Not targetTextBox Is Nothing Then
' Construct the full date based on selected day, current month, and year
Dim selectedDate As Date
selectedDate = DateSerial(CInt(lblYear.Caption), MonthNumber(lblMonth.Caption), CInt(Me.ActiveControl.Caption))

' Assign the formatted date to the target textbox
targetTextBox.Value = Format(selectedDate, "mm/dd/yy")

' Close the calendar
Unload Me
Else
MsgBox "No target textbox set!", vbExclamation
End If
End Sub





Private Sub UserForm_Initialize()
' Default to the current month and year
lblMonth.Caption = Format(Date, "MMMM") ' Full month name (e.g., "March")
lblYear.Caption = Year(Date) ' Current year

' Initialize the calendar view with days of the current month
UpdateCalendar
End Sub

Private Sub btnPrevMonth_Click()
Dim currentMonth As Integer
Dim currentYear As Integer
Dim newDate As Date

' Get current month and year
currentMonth = Month(DateValue("1 " & lblMonth.Caption & " " & lblYear.Caption))
currentYear = CInt(lblYear.Caption)

' Decrement the month
If currentMonth = 1 Then
currentMonth = 12
currentYear = currentYear - 1
Else
currentMonth = currentMonth - 1
End If

' Update labels
lblMonth.Caption = monthName(currentMonth)
lblYear.Caption = currentYear

' Refresh calendar display
UpdateCalendar
End Sub

Private Sub btnNextMonth_Click()
Dim currentMonth As Integer
Dim currentYear As Integer
Dim newDate As Date

Dim monthText As String
Dim yearText As String

monthText = lblMonth.Caption
yearText = lblYear.Caption

' Validate month and year before converting
If monthText = "" Or yearText = "" Then Exit Sub ' Prevent errors if labels are empty

' Validate that year is numeric
If Not IsNumeric(yearText) Then Exit Sub

' Convert month name to number safely
currentMonth = MonthNumber(monthText)
currentYear = Val(yearText)

If currentMonth = 0 Or currentYear < 1900 Then Exit Sub ' Ensure valid values

currentYear = CInt(lblYear.Caption)

' Increment the month
If currentMonth = 12 Then
currentMonth = 1
currentYear = currentYear + 1
Else
currentMonth = currentMonth + 1
End If

' Update labels
lblMonth.Caption = monthName(currentMonth)
lblYear.Caption = currentYear

' Refresh calendar display
UpdateCalendar
End Sub

Private Sub UpdateCalendar()
Dim firstDay As Integer, totalDays As Integer
Dim i As Integer, startIndex As Integer
Dim currentMonth As Integer, currentYear As Integer
Dim currentDate As Date

' Ensure lblMonth and lblYear contain valid data
If lblMonth.Caption = "" Or lblYear.Caption = "" Then Exit Sub
If Not IsNumeric(lblYear.Caption) Then Exit Sub

' Get current month and year
currentMonth = MonthNumber(lblMonth.Caption)
currentYear = CInt(lblYear.Caption)

' Get first day of the month (1 = Sunday, 7 = Saturday)
currentDate = DateSerial(currentYear, currentMonth, 1)
firstDay = Weekday(currentDate, vbSunday) ' Adjusted for Sunday start

' Get the total number of days in the current month
totalDays = Day(DateSerial(currentYear, currentMonth + 1, 0))

' Determine where the first day of the month should start in btnDay1-42
startIndex = firstDay ' Since btnDay1 starts on a Sunday, no need for adjustments

' Reset all buttons
For i = 1 To 42
With Me.Controls("btnDay" & i)
.Caption = ""
.Visible = False
End With
Next i

' Populate the calendar with actual dates
For i = 1 To totalDays
With Me.Controls("btnDay" & (startIndex + i - 1))
.Caption = i
.Visible = True
End With
Next i
End Sub

Private Function MonthNumber(monthName As String) As Integer
Dim monthList As Variant
monthList = Array("January", "February", "March", "April", "May", "June", _
"July", "August", "September", "October", "November", "December")

Dim i As Integer
For i = LBound(monthList) To UBound(monthList)
If monthList(i) = monthName Then
MonthNumber = i + 1
Exit Function
End If
Next i

MonthNumber = 0 ' Return 0 if no match (prevents errors)
End Function

Calendar pops up but not passing the date to the textboxvusing the latest code that you provided.
Else
MsgBox "No target textbox set!", vbExclamation
End If
End Sub





Private Sub UserForm_Initialize()
' Default to the current month and year
lblMonth.Caption = Format(Date, "MMMM") ' Full month name (e.g., "March")
lblYear.Caption = Year(Date) ' Current year

' Initialize the calendar view with days of the current month
UpdateCalendar
End Sub

Private Sub btnPrevMonth_Click()
Dim currentMonth As Integer
Dim currentYear As Integer
Dim newDate As Date

' Get current month and year
currentMonth = Month(DateValue("1 " & lblMonth.Caption & " " & lblYear.Caption))
currentYear = CInt(lblYear.Caption)

' Decrement the month
If currentMonth = 1 Then
currentMonth = 12
currentYear = currentYear - 1
Else
currentMonth = currentMonth - 1
End If

' Update labels
lblMonth.Caption = monthName(currentMonth)
lblYear.Caption = currentYear

' Refresh calendar display
UpdateCalendar
End Sub

Private Sub btnNextMonth_Click()
Dim currentMonth As Integer
Dim currentYear As Integer
Dim newDate As Date

Dim monthText As String
Dim yearText As String

monthText = lblMonth.Caption
yearText = lblYear.Caption

' Validate month and year before converting
If monthText = "" Or yearText = "" Then Exit Sub ' Prevent errors if labels are empty

' Validate that year is numeric
If Not IsNumeric(yearText) Then Exit Sub

' Convert month name to number safely
currentMonth = MonthNumber(monthText)
currentYear = Val(yearText)

If currentMonth = 0 Or currentYear < 1900 Then Exit Sub ' Ensure valid values

currentYear = CInt(lblYear.Caption)

' Increment the month
If currentMonth = 12 Then
currentMonth = 1
currentYear = currentYear + 1
Else
currentMonth = currentMonth + 1
End If

' Update labels
lblMonth.Caption = monthName(currentMonth)
lblYear.Caption = currentYear

' Refresh calendar display
UpdateCalendar
End Sub

Private Sub UpdateCalendar()
Dim firstDay As Integer, totalDays As Integer
Dim i As Integer, startIndex As Integer
Dim currentMonth As Integer, currentYear As Integer
Dim currentDate As Date

' Ensure lblMonth and lblYear contain valid data
If lblMonth.Caption = "" Or lblYear.Caption = "" Then Exit Sub
If Not IsNumeric(lblYear.Caption) Then Exit Sub

' Get current month and year
currentMonth = MonthNumber(lblMonth.Caption)
currentYear = CInt(lblYear.Caption)

' Get first day of the month (1 = Sunday, 7 = Saturday)
currentDate = DateSerial(currentYear, currentMonth, 1)
firstDay = Weekday(currentDate, vbSunday) ' Adjusted for Sunday start

' Get the total number of days in the current month
totalDays = Day(DateSerial(currentYear, currentMonth + 1, 0))

' Determine where the first day of the month should start in btnDay1-42
startIndex = firstDay ' Since btnDay1 starts on a Sunday, no need for adjustments

' Reset all buttons
For i = 1 To 42
With Me.Controls("btnDay" & i)
.Caption = ""
.Visible = False
End With
Next i

' Populate the calendar with actual dates
For i = 1 To totalDays
With Me.Controls("btnDay" & (startIndex + i - 1))
.Caption = i
.Visible = True
End With
Next i
End Sub

Private Function MonthNumber(monthName As String) As Integer
Dim monthList As Variant
monthList = Array("January", "February", "March", "April", "May", "June", _
"July", "August", "September", "October", "November", "December")

Dim i As Integer
For i = LBound(monthList) To UBound(monthList)
If monthList(i) = monthName Then
MonthNumber = i + 1
Exit Function
End If
Next i

MonthNumber = 0 ' Return 0 if no match (prevents errors)
End Function