'Simple calendar

'Insert a new module, copy the following code and paste to the module.
'Run "SimpleCalendar" macro.


Option Explicit

Private Const sAppName = "Simple Calendar"

Sub SimpleCalendar()
    Dim i As Long, j As Long, k As Long
    Dim sAddr1 As String, sAddr2 As String
    Dim sDefault As String
    Dim oRange As Range

    On Error GoTo ErrorHandler

    If ActiveCell Is Nothing Then
        sDefault = ""
    Else
        sDefault = ActiveCell.Address
    End If

    On Error Resume Next
    Set oRange = Application.InputBox( _
        prompt:="Select the starting cell.", _
        Title:=sAppName, Default:=sDefault, Type:=8)
    On Error GoTo ErrorHandler
    If oRange Is Nothing Then
        Exit Sub
    End If

    With oRange.Cells(1, 1)
        .Worksheet.Parent.Activate
        .Worksheet.Select
        .Resize(8, 7).Select
    End With

    If MsgBox("Create a calendar in selected range?", _
        vbOKCancel Or vbExclamation, sAppName) <> vbOK Then Exit Sub
    Application.ScreenUpdating = False
    Selection.Clear
    With Selection
        .Range("E1:F1").Value = Array(Year(Date), Month(Date))
        .Range("C1").FormulaR1C1 = "=TEXT(DATE(1,RC[3],1),""mmmm"")"
        .Range("G1").FormulaR1C1 = _
            "=DATE(RC[-2],RC[-1],1)-WEEKDAY(DATE(RC[-2],RC[-1],1),1)"
        .Range("A2:G2").Value = _
            Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")
        sAddr1 = .Range("G1").Address(False, False)
        sAddr2 = .Range("F1").Address(False, False)
        With .Range("A3")
            k = 1
            For i = 1 To 6
                For j = 1 To 7
                    .Cells(i, j).Formula = _
                        "=IF(MONTH(" & sAddr1 & "+" & k & ")=" & _
                        sAddr2 & ",DAY(" & sAddr1 & "+" & k & "),"""")"
                    k = k + 1
                Next
            Next
        End With

        .Range("C1:E1").Font.ColorIndex = 14
        .Range("C1:E1").Font.Bold = True
        .Range("C1:D1").HorizontalAlignment = xlCenterAcrossSelection
        .Range("E1").HorizontalAlignment = xlCenter
        .Range("A2:G2").HorizontalAlignment = xlCenter
        .Range("F1:G1").NumberFormat = """"";"""""
        .Range("A2:A8").Font.ColorIndex = 3
        .Range("G2:G8").Font.ColorIndex = 5

        .Range("E1").EntireColumn.AutoFit
        .Range("A1:G1").ColumnWidth = .Range("E1").ColumnWidth

        With .Range("A1:G8")
            .Interior.ColorIndex = 2
            With .Borders(xlTop)
                .Weight = xlThin
                .ColorIndex = 15
            End With
            With .Borders(xlBottom)
                .Weight = xlThin
                .ColorIndex = 15
            End With
            .BorderAround LineStyle:=xlDouble, ColorIndex:=16
        End With
        .Range("C1:D1").Interior.ColorIndex = xlNone
        .Range("A3:G8").NumberFormat = "0_ "
        With .Range("A2:G2")
            With .Borders(xlTop)
                .LineStyle = xlDouble
                .ColorIndex = 16
            End With
            With .Borders(xlBottom)
                .LineStyle = xlDouble
                .ColorIndex = 16
            End With
        End With
        i = Date - .Range("G1").Value - 1
        .Cells(3 + i \ 7, i Mod 7 + 1).Select
    End With
    Exit Sub

ErrorHandler:
    MsgBox Error(Err) & " (" & Err & ")", vbExclamation, sAppName
    Exit Sub
End Sub