VBA not showing first date of month in dynamic calendar

[Caz46]

Hi,

I am creating a dynamic calendar and would like for the first of the month to show under the correct day of the week.

Here is my code:

Sub Show_Date()

Dim First_Date As Date
Dim Last_Date As Date

First_Date = VBA.CDate("1-" & Me.cmbMonth.Value & "-" & Me.cmbYear.Value)
Last_Date = VBA.DateSerial(Year(First_Date), Month(First_Date) + 1, 1) - 1

Dim i As Integer
Dim btn As MSForms.CommandButton

'=== to remove any caption from buttons
For i = 1 To 42
Set btn = Me.Controls("CommandButton" & i)
btn.Caption = ""
Next i

'=== set first date of the month
For i = 1 To 7
Set btn = Me.Controls("CommandButton" & i)

If VBA.Weekday(First_Date) = i Then
btn.Caption = "1"
End If

Next i

Have I missed something or written something incorrectly?

Thanks in advance.
Caz

 

[NoSparks]

Try declaring First_Date as String and test to see what this gives you

First_Date = "1-" & Me.cmbMonth.Value & "-" & Me.cmbYear.Value
MsgBox Format(Day(CDate(First_Date)), "dddd")

 

[dmt32]

Hi,
assuming that your userform contains a 7 x 6 matrix of commandbuttons named CommandButton1 - 42 & Week Day labels named Label1 -7 then try following & see if does what you want

Place following codes in your userforms code page

Private Sub cmbMonth_Change()
    BuildCalendar Me
End Sub

Private Sub cmbYear_Change()
    BuildCalendar Me
End Sub

Place following code either in standard module or your forms code page

Sub BuildCalendar(ByVal Form As Object)
    Dim i As Integer, d As Integer
    Dim DaysInMonth As Integer, CalToDay As Integer
    Dim CalMonth As Integer, CalYear As Integer
    Dim MonthDate As Date
    Dim ThisMonth As Boolean
    Dim WeekBegins As VbDayOfWeek
    
    
'default settings
    CalMonth = Month(Date)
    CalYear = Year(Date)
    
'set 1st day of week
    WeekBegins = vbMonday
    
'today
    CalToDay = Day(Date)
    
'get combobox Month - Year values
    If Len(Form.cmbMonth) >= 3 Then CalMonth = Month(DateValue("01/" & Form.cmbMonth))
    If Len(Form.cmbYear) = 4 Then CalYear = Val(Form.cmbYear.Value)
    
'check selection is in current month
    ThisMonth = CBool(CalMonth = Month(Date) And CalYear = Year(Date))
    
    MonthDate = DateValue("01/" & CalMonth & "/" & CalYear)
    
    
'weekday for selected month
    WeekDayStart = Weekday(MonthDate, WeekBegins)
'no days in month
    DaysInMonth = Day(DateSerial(CalYear, CalMonth + 1, 1) - 1)
    
    d = 1
    For i = 1 To 42
    
'weekday labels
        If i < 8 Then Form.Controls("Label" & i).Caption = WeekdayName(i, True, WeekBegins)

        With Form.Controls("CommandButton" & i)
'add day
            .Caption = Format(Day(DateAdd("D", i - WeekDayStart, MonthDate)), "0")
            
            If i >= WeekDayStart And d <= DaysInMonth Then
'today's date
                If d = CalToDay And ThisMonth Then
'add date marker
                    .BackColor = vbRed: .ForeColor = vbWhite: .Font.Bold = True
            
                Else
'standard backcolor
                    .BackColor = vbButtonFace: .ForeColor = vbBlack: .Font.Bold = False
                End If
'enable button
                .Enabled = True
'increment day counter
                d = d + 1
            Else
'lockout button
                .Enabled = False
            End If
        End With
    Next i
    
End Sub

I have assumed that you already have code to populate the comboboxes

Hope Helpful

Dave

 

[Rick Rothstein]

@Dave... Unless I have something setup differently than you, I get your BuildCalendar subroutine producing incorrect result for months after January (only tested the yea 2020). I believe the following code will work correctly. Note that I choose to make the day numbers for the current month large and the day numbers in the surrounding months smaller. Oh, and I chose to start the month with Sunday, not Monday.

Sub BuildCalendar(ByVal Form As Object)
  Dim N As Long, X As Long, LastDay As Date, FirstDay As Date
  If Len(cmbMonth.Text) > 0 And Len(cmbYear) > 0 Then
    FirstDay = CDate("1-" & cmbMonth & "-" & cmbYear)
    LastDay = Application.EoMonth(FirstDay, 0)
    If Weekday(FirstDay) > 1 Then
      For X = Weekday(FirstDay) - 1 To 1 Step -1
        N = N + 1
        With Me.Controls("CommandButton" & X)
          .Caption = Day(FirstDay - N)
          .Font.Size = 8
        End With
      Next
    End If
    N = 0
    For X = Weekday(FirstDay) To 42
      With Me.Controls("CommandButton" & X)
        .Caption = Day(FirstDay + N)
        .Font.Size = IIf(N < Day(LastDay), 14, 8)
      End With
      If N < 7 Then Me.Controls("Label" & N + 1).Caption = Format(N + 1, "dddd")
      N = N + 1
    Next
  End If
End Sub

 

[dmt32]

Hi Rick,
thanks for this - as always I am guilty of either just typing out & posting code or lightly testing it & freely admit that I sometimes make some bloopers.
Following up on your post I have checked against system calendar here in UK & seems produce correct result for me so perhaps a regional thing maybe??
Be interesting to get feedback from OP.

I did include option for OP to specify day the week begins which should dynamically change weekday name label placements - I Like the different option you have come up with to highlight Today and as always, you manage to produce code do the same thing with a lot less it!

Appreciate the input & OP now has two different ideas to work with.

Keep safe in these difficult times

Dave