vba - Calender code

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
976
Office Version
  1. 2010
Platform
  1. Windows
Hi Team,

Does anyone have readymade vba code for Calender , Excluding Datepicker on forms.

I want to give user an Option to select Start Date and End Date via Calender.


Thanks in advance for your help.

Regards,
mg
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
.
VBA Code:
Option Explicit

Dim Buttons()  As New clsCmdButton

Sub Show_Cal()
    'use class module to create commandbutton collection, then show calendar

    Dim iCmdBtns As Integer
    Dim ctl    As Control

    iCmdBtns = 0
    For Each ctl In frmCalendar.Controls
        If TypeName(ctl) = "CommandButton" Then
            If ctl.Name <> "CB_Close" Then
                iCmdBtns = iCmdBtns + 1
                ReDim Preserve Buttons(1 To iCmdBtns)
                Set Buttons(iCmdBtns).CmdBtnGroup = ctl
            End If
        End If
    Next ctl

    frmCalendar.Show

End Sub

Private Sub CB_Close_Click()
    Unload Me
End Sub

Private Sub D19_Click()
    addDate
End Sub
Sub addDate()
    ActiveCell.Value = Parent
End Sub

Private Sub UserForm_Initialize()

    Dim i      As Long
    Dim lYearsAdd As Long
    Dim lYearStart As Long

    lYearStart = Year(Date) - 10
    lYearsAdd = Year(Date) + 10
    With Me
        For i = 1 To 12
            .CB_Mth.AddItem Format(DateSerial(Year(Date), i, 1), "mmmm")
        Next

        For i = lYearStart To lYearsAdd
            .CB_Yr.AddItem Format(DateSerial(i, 1, 1), "yyyy")
        Next

        .Tag = "Calendar"
        .CB_Mth.ListIndex = Month(Date) - 1
        .CB_Yr.ListIndex = Year(Date) - lYearStart
        .Tag = ""
    End With
    Call Build_Calendar

End Sub

Private Sub CB_Mth_Change()
    If Not Me.Tag = "Calendar" Then Build_Calendar
End Sub

Private Sub CB_Yr_Change()
    If Not Me.Tag = "Calendar" Then Build_Calendar
End Sub

Sub Build_Calendar()

    Dim i      As Integer
    Dim dTemp  As Date
    Dim dTemp2 As Date
    Dim iFirstDay As Integer
    With Me
        .Caption = " " & .CB_Mth.Value & " " & .CB_Yr.Value

        dTemp = CDate("01/" & .CB_Mth.Value & "/" & .CB_Yr.Value)
        iFirstDay = WeekDay(dTemp, vbSunday)
        .Controls("D" & iFirstDay).SetFocus

        For i = 1 To 42
            With .Controls("D" & i)
                dTemp2 = DateAdd("d", (i - iFirstDay), dTemp)
                .Caption = Format(dTemp2, "d")
                .Tag = dTemp2
                .ControlTipText = Format(dTemp2, "dd/mm/yy")
                'add dates to the buttons
                If Format(dTemp2, "mmmm") = CB_Mth.Value Then
                    If .BackColor <> &H80000016 Then .BackColor = &H80000018
                    If Format(dTemp2, "m/d/yy") = Format(Date, "m/d/yy") Then .SetFocus
                    .Font.Bold = True
                Else
                    If .BackColor <> &H80000016 Then .BackColor = &H8000000F
                    .Font.Bold = False
                End If
                'format the buttons
            End With
        Next
    End With

End Sub


Download workbook : Calendar Click Add Date to Cell.xls
 
Upvote 0
Hi Logit,

Thanks for sharing lovely code, I have downloaded the workbook,

Now Can you please tell me where to update above code.



Regards,
mg
 
Last edited:
Upvote 0
Hi Logit ,

Your code is working as expected. Thanks for sharing it.

Regards,
mg
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,243
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top