Creating Worksheet Calendar through VBA

VBA code for creating a Calendar in Excel Worksheet

Option Explicit

Sub createClaendar()

Dim lmonth, ldays As Long

Dim strmonth, straddress As String

Dim myrng, mycell As Range

Dim mydate As Date

    Application.ScreenUpdating = False

    On Error Resume Next

    'removing grid lines in excel sheet

    ActiveWindow.DisplayGridlines = False

    'Fixing cells size

    With Cells

        .ColumnWidth = 6

        .Font.Size = 8

    End With

    'Select quaterly month's name in row wise

    For lmonth = 1 To 4

        Select Case lmonth

            Case 1

                strmonth = "January"

                Set myrng = Range("A1")

            Case 2

                strmonth = "April"

                Set myrng = Range("A8")

            Case 3

                strmonth = "July"

                Set myrng = Range("A15")

            Case 4

                strmonth = "October"

                Set myrng = Range("A22")

        End Select

        'Entering month's name

        With myrng

            .Value = strmonth

            .Font.Bold = True

            .Interior.ColorIndex = 22

                With .Range("A1:G1")

                     .Merge

                     .BorderAround LineStyle:=xlContinuous

                End With

                'seleting months rowwise

            .Range("A1:G1").AutoFill Destination:=.Range("A1:U1")

        End With

        

        

    

      Next lmonth

      lmonth = 1

      For lmonth = 1 To 12

      straddress = Choose(lmonth, "A2:G7", "H2:N7", "O2:U7", "A9:G14", "H9:N14", "O9:U14", "A16:G21", "H16:N21", "O16:U21", _

                "A23:G28", "H23:N28", "O23:U28")

      ldays = 0

            For Each mycell In Range(straddress)

              ldays = ldays + 1

              mydate = DateSerial(Year(Date), lmonth, ldays)

                  If Month(mydate) = lmonth Then

                      'fill each month's range

                          With mycell

                             .Value = DateSerial(Year(Date), lmonth, ldays)

                             .NumberFormat = "ddd dd"

                          End With

                  End If

            Next mycell

      Next lmonth

    

End Sub