BTW, your code can be tidied up a lot.
I fell you over-comment, it can impede anyone reading the code. Adding a comment for Application.Screenupdating = False is way overkill IMO, and you must be careful that you comments are meaningfull. You had a comment to say you were turning gridlines on, then turned them off. Apart from being an unnecessary comment, it was just plain wrong.
[VBA]Sub CalBeta1(Optional InputDate As String)
Dim diff As Long
Dim finalday As Date
Dim startday As Date
Application.ScreenUpdating = False
If InputDate = "" Then
' Use InputBox to get desired month and year and set variable MyInput.
MyInput = InputBox("Type in Month and year for Calendar. [Must be in format: Jan 2012]")
' Allow user to end macro with Cancel in InputBox.
If MyInput = "" Then Exit Sub
' Get the date value of the beginning of inputted month.
startday = DateValue(MyInput)
Else
startday = DateValue(InputDate)
End If
' Clear area a1:af35 including any previous calendar.
Range("D3:AZ35").Clear
' Check if valid date but not the first of the month
' -- if so, reset StartDay to first day of month.
If Day(startday) <> 1 Then
startday = startday - Day(startday) + 1
End If
' BEGIN FORMATTING
' Prepare cell for Month and Year as fully spelled out.
' Center the title with appropriate formatting
With Range("D1")
.Value = "Attendance " '& Year(startday)
.Font.FontStyle = Arial
.Font.Size = 12
.Font.Bold = True
.Font.Italic = False
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
' Prep next row to display month and year
With Range("D2")
.Value = MonthName(Month(startday)) & Chr(32) & Year(startday)
.NumberFormat = "mmmm yyyy"
.Font.FontStyle = Arial
.Font.Size = 12
.Font.Bold = True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
' Set variables to identify the year and month as separate variables.
curyear = Year(startday)
curmonth = Month(startday)
' Set variable and calculate the first day of the next month.
finalday = DateSerial(curyear, curmonth + 1, 1)
' Calculate how many days in the given month
mydays = Day(DateSerial(Year(Date), curmonth + 1, 1) - 1)
' Begin AutoFill days
' need to do a column count and have loop run until column count is equal to mydays
With Range("D3")
.Value = Format(startday, "ddd")
.Font.Name = "Arial"
.Font.Size = 10
.AutoFill Destination:=.Resize(1, mydays), Type:=xlFillDefault
End With
' Place a "1" in cell position of the first day of the chosen
' month based on DayofWeek.
Range("D4").Value = 1
' Used to input data in the proper format. I.E. if I select column C, I have to -1, if I select column D I have to -2
myspread = mydays - 1
my2spread = mydays - 2
Range("E4").Insert
With Range("E4")
.Formula = "=(D4+1)"
.AutoFill Destination:=.Resize(1, myspread), Type:=xlFillDefault
End With
'Format the Calendar Range
With Range("D3:AI25")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
With Range("D3:AI4").Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Columns("D:AI").ColumnWidth = 3
Range("D5:AI25").ClearContents
ActiveWindow.DisplayGridlines = False
' Resize window to show all of calendar (may have to be adjusted
' for video configuration).
ActiveWindow.WindowState = xlMaximized
ActiveWindow.ScrollRow = 1
' Prevent going to error trap unless error found by exiting Sub here.
Range("A5").Select
Application.ScreenUpdating = True
MsgBox "New Monthly Calendar created", vbOKOnly + vbInformation, "FTE Record"
Exit Sub
MyErrorTrap:
MsgBox "You may not have entered your Month and Year correctly." & Chr(13) & _
"Spell the Month correctly (or use 3 letter abbreviation)" & Chr(13) & _
"and 4 digits for the Year"
MyInput = InputBox("Type in Month and year for Calendar. [Format: January 2011] ")
If MyInput = "" Then Exit Sub
Resume
End Sub[/VBA]