It’s always useful to have a calendar in Excel. Having one lets you save it on a shared network drive, so everyone involved in a particular project knows what’s going on and important dates coming up. Creating a calendar in Excel can be a tedious task if done manually. Thankfully, using the Visual Basic Editor, you can easily create a calendar in Excel.
By creating a simple macro, you can have Excel ask a user to input the month and year, and let Excel do the rest!
I’m assuming that if you’re reading this you’ve already taken a look at my guide that describes how to install and use macros. If not, read up on the Single Workbook Use section for purposes of this macro.
I’ll explain each step of this macro code, and then put it all together at the end, to help you understand what it’s doing.
The first part of the code is to make sure the current sheet is unprotected. This will enable the macro to make the necessary edits to the sheet. This is accomplished with the following line:
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
Scenarios:=False
Application.ScreenUpdating = False
Next, you’ll want to make sure that any errors from data entry are resolved so that the macro can work properly. (More on this later).
On Error GoTo ErrorMessage
Here, we’ll tell the macro to clear whatever is in the cells where we want the calendar to appear.
Range(“A1:G14”).Clear
In order to get users to input a date, you’ll need to tell Excel to open an input box and ask the user to input the date. You’ll also want the date the user puts into the box to be defined as a variable. If they don’t input anything, or cancel out of the input box, you’ll want to end the process.
InputDate = InputBox(“Type in Month and Year for Calendar “)
If InputDate = “” Then Exit Sub
In order for the macro to properly format the calendar in Excel, it needs to know what the first day of the month is. Since we just had our users input the month and year, we need to convert this into a number that Excel recognizes as a date. You’ll also want to make sure that the date it is formatting is the first day in the month, otherwise tell it to change to the first day.
FirstDay = DateValue(InputDate)
If Day(FirstDay) <> 1 Then
FirstDay = DateValue(Month(FirstDay) & “/1/” & _
Year(FirstDay))
End If
Next, you’ll want to start formatting your cells so it starts to look like a calendar.
Range(“A1”).NumberFormat = “mmmm yyyy” — This formats the header to display just the month and year.
Here, we set up the cells that will contain the days of the week
With Range(“A1:G1”)
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Font.Size = 18
.Font.Bold = True
.RowHeight = 35
End With
With Range(“A2:G2”)
.ColumnWidth = 14
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.Font.Size = 12
.Font.Bold = True
.RowHeight = 20
End With
Range(“A2”) = “Sunday”
Range(“B2”) = “Monday”
Range(“C2”) = “Tuesday”
Range(“D2”) = “Wednesday”
Range(“E2”) = “Thursday”
Range(“F2”) = “Friday”
Range(“G2”) = “Saturday”
Now we want to input the dates, and most importantly we want to put them in the correct location.
With Range(“A3:G8”)
.HorizontalAlignment = xlRight
.VerticalAlignment = xlTop
.Font.Size = 18
.Font.Bold = True
.RowHeight = 21
End With
Range(“A1”).Value = Application.Text(InputDate, “mmmm yyyy”)
DayofWeek = Weekday(StartDay)
CurrenttYear = Year(StartDay)
CurrentMonth = Month(StartDay)
LastDay = DateSerial(CurrentYear, CurrentMonth + 1, 1)
Select Case DayofWeek
Case 1
Range(“A3”).Value = 1
Case 2
Range(“B3”).Value = 1
Case 3
Range(“C3”).Value = 1
Case 4
Range(“D3”).Value = 1
Case 5
Range(“E3”).Value = 1
Case 6
Range(“F3”).Value = 1
Case 7
Range(“G3”).Value = 1
End Select
OK, now we have the first day of the month in, now we need to get the rest in, but considering that months all have different numbers of days, and some months (February) can have a different number of days from year to year, we need to tell the macro to only put as many days as there are in the month.
For Each cell In Range(“A3:G8”)
RowCell = cell.Row
ColCell = cell.Column
If cell.Column = 1 And cell.Row = 3 Then
ElseIf cell.Column <> 1 Then
If cell.Offset(0, -1).Value >= 1 Then
cell.Value = cell.Offset(0, -1).Value + 1
If cell.Value > (LastDay – FirstDay) Then
cell.Value = “”
Exit For
End If
End If
ElseIf cell.Row > 3 And cell.Column = 1 Then
cell.Value = cell.Offset(-1, 6).Value + 1
If cell.Value > (LastDay – FirstDay) Then
cell.Value = “”
Exit For
End If
End If
Next
Now that we have the dates, we’ll want to create a little space to enter in some data. To do this we’ll create a new row under each row that contains the dates.
For x = 0 To 5
Range(“A4”).Offset(x * 2, 0).EntireRow.Insert
With Range(“A4:G4”).Offset(x * 2, 0)
.RowHeight = 65
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Font.Size = 10
.Font.Bold = False
.Locked = False
End With
Now we’ll format the calendar and the rest of the sheet so it actually looks like a calendar.
With Range(“A3”).Offset(x * 2, 0).Resize(2, 7).Borders(xlLeft)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Range(“A3”).Offset(x * 2, 0).Resize(2, 7).Borders(xlRight)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Range(“A3”).Offset(x * 2, 0).Resize(2, 7).BorderAround Weight:=xlThick, ColorIndex:=xlAutomatic
Next
If Range(“A13”).Value = “” Then Range(“A13”).Offset(0, 0) .Resize(2, 8).EntireRow.Delete
ActiveWindow.DisplayGridlines = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWindow.WindowState = xlMaximized
ActiveWindow.ScrollRow = 1
Now we’ll end the macro, assuming there were no errors encountered along the way.
Application.ScreenUpdating = True
Exit Sub
If there were errors, we’ll need to define the error message from above.
ErrorCorrect:
MsgBox “You may not have entered your Month and Year in the correct format.” _
& Chr(13) & “Spell the Month correctly” _
& ” (or use 3 letter abbreviation)” _
& Chr(13) & “and 4 digits for the Year”
InputDate = InputBox(“Type in Month and Year for Calendar”)
If InputDate = “” Then Exit Sub
Resume
End Sub
Now that you’ve seen the pieces, here’s the complete code.