Edit code to Remove empty row below the date.

pedie

pedie

Well-known Member
Joined
Apr 28, 2010
Messages
3,875
I have this code from the official site to create monthly Calendar.
I want to create a simple monthly calender.
can someone please edit this code. As for now it below the date there is an empty row i just want to get rid of that.
Thanks for helping
Pedie.
http://support.microsoft.com/kb/150774
PHP: 
Sub CalendarMaker()
      Application.ScreenUpdating = False
       On Error GoTo MyErrorTrap
       Range("a1:g14").Clear
       MyInput = InputBox("Type in Month and year for Calendar ")
       If MyInput = "" Then Exit Sub
       StartDay = DateValue(MyInput)
       If Day(StartDay) <> 1 Then
           StartDay = DateValue(Month(StartDay) & "/1/" & _
               Year(StartDay))
       End If
       Range("a1").NumberFormat = "mmmm yyyy"
       
       With Range("a1:g1")
           .HorizontalAlignment = xlCenterAcrossSelection
           .VerticalAlignment = xlCenter
           .Font.Size = 9
           .Font.Bold = False
       End With
       ' Prepare a2:g2 for day of week labels with centering, size,
       ' height and bolding.
       With Range("a2:g2")
           .VerticalAlignment = xlCenter
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlCenter
           .Orientation = xlHorizontal
           .Font.Size = 9
           .Font.Bold = False
       End With
       ' Put days of week in a2:g2.
       Range("a2") = "S"
       Range("b2") = "M"
       Range("c2") = "T"
       Range("d2") = "W"
       Range("e2") = "T"
       Range("f2") = "F"
       Range("g2") = "S"
       ' Prepare a3:g7 for dates with left/top alignment, size, height
       ' and bolding.
       With Range("a3:g8")
           .HorizontalAlignment = xlRight
           .VerticalAlignment = xlTop
           .Font.Size = 9
           .Font.Bold = False
       End With
       ' Put inputted month and year fully spelling out into "a1".
       Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")
       ' Set variable and get which day of the week the month starts.
       DayofWeek = Weekday(StartDay)
       ' 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)
       ' Place a "1" in cell position of the first day of the chosen
       ' month based on DayofWeek.
       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
       ' Loop through range a3:g8 incrementing each cell after the "1"
       ' cell.
       For Each cell In Range("a3:g8")
           RowCell = cell.Row
           ColCell = cell.Column
           ' Do if "1" is in first column.
           If cell.Column = 1 And cell.Row = 3 Then
           ' Do if current cell is not in 1st column.
           ElseIf cell.Column <> 1 Then
               If cell.Offset(0, -1).Value >= 1 Then
                   cell.Value = cell.Offset(0, -1).Value + 1
                   ' Stop when the last day of the month has been
                   ' entered.
                   If cell.Value > (FinalDay - StartDay) Then
                       cell.Value = ""
                       ' Exit loop when calendar has correct number of
                       ' days shown.
                       Exit For
                   End If
               End If
           ' Do only if current cell is not in Row 3 and is in Column 1.
           ElseIf cell.Row > 3 And cell.Column = 1 Then
               cell.Value = cell.Offset(-1, 6).Value + 1
               ' Stop when the last day of the month has been entered.
               If cell.Value > (FinalDay - StartDay) Then
                   cell.Value = ""
                   ' Exit loop when calendar has correct number of days
                   ' shown.
                   Exit For
               End If
           End If
       Next
       ' Create Entry cells, format them centered, wrap text, and border
       ' around days.
       For x = 0 To 5
           Range("A4").Offset(x * 2, 0).EntireRow.Insert
           With Range("A4:G4").Offset(x * 2, 0)
               .HorizontalAlignment = xlCenter
               .VerticalAlignment = xlTop
               .WrapText = True
               .Font.Size = 9
               .Font.Bold = False
               ' Unlock these cells to be able to enter text later after
               ' sheet is protected.
               .Locked = False
           End With
           ' Put border around the block of dates.
           With Range("A3").Offset(x * 2, 0).Resize(2, _
           7).Borders(xlLeft)
               .Weight = xlHairline
               .ColorIndex = xlAutomatic
           End With
           With Range("A3").Offset(x * 2, 0).Resize(2, _
           7).Borders(xlRight)
               .Weight = xlHairline
               .ColorIndex = xlAutomatic
           End With
           Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
              Weight:=xlHairline, ColorIndex:=xlAutomatic
       Next
       If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
          .Resize(2, 8).EntireRow.Delete
       ' Turn off gridlines.
       ActiveWindow.DisplayGridlines = True
       ' Protect sheet to prevent overwriting the dates.
       ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
          Scenarios:=False
       ' Resize window to show all of calendar (may have to be adjusted
       ' for video configuration).
       ActiveWindow.WindowState = xlMaximized
       ActiveWindow.ScrollRow = 1
       ' Allow screen to redraw with calendar showing.
       Application.ScreenUpdating = True
       ' Prevent going to error trap unless error found by exiting Sub
       ' here.
       Exit Sub
   ' Error causes msgbox to indicate the problem, provides new input box,
   ' and resumes at the line that caused the error.
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")
       If MyInput = "" Then Exit Sub
       Resume
End Sub
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
Try this

Code: 
Sub CalendarMaker()
      Application.ScreenUpdating = False
       On Error GoTo MyErrorTrap
       Range("a1:g14").Clear
       MyInput = InputBox("Type in Month and year for Calendar ")
       If MyInput = "" Then Exit Sub
       StartDay = DateValue(MyInput)
       If Day(StartDay) <> 1 Then
           StartDay = DateValue(Month(StartDay) & "/1/" & _
               Year(StartDay))
       End If
       Range("a1").NumberFormat = "mmmm yyyy"
       
       With Range("a1:g1")
           .HorizontalAlignment = xlCenterAcrossSelection
           .VerticalAlignment = xlCenter
           .Font.Size = 9
           .Font.Bold = False
       End With
       ' Prepare a2:g2 for day of week labels with centering, size,
       ' height and bolding.
       With Range("a2:g2")
           .VerticalAlignment = xlCenter
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlCenter
           .Orientation = xlHorizontal
           .Font.Size = 9
           .Font.Bold = False
       End With
       ' Put days of week in a2:g2.
       Range("a2") = "S"
       Range("b2") = "M"
       Range("c2") = "T"
       Range("d2") = "W"
       Range("e2") = "T"
       Range("f2") = "F"
       Range("g2") = "S"
       ' Prepare a3:g7 for dates with left/top alignment, size, height
       ' and bolding.
       With Range("a3:g8")
           .HorizontalAlignment = xlRight
           .VerticalAlignment = xlTop
           .Font.Size = 9
           .Font.Bold = False
       End With
       ' Put inputted month and year fully spelling out into "a1".
       Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")
       ' Set variable and get which day of the week the month starts.
       DayofWeek = Weekday(StartDay)
       ' 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)
       ' Place a "1" in cell position of the first day of the chosen
       ' month based on DayofWeek.
       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
       ' Loop through range a3:g8 incrementing each cell after the "1"
       ' cell.
       For Each cell In Range("a3:g8")
           RowCell = cell.Row
           ColCell = cell.Column
           ' Do if "1" is in first column.
           If cell.Column = 1 And cell.Row = 3 Then
           ' Do if current cell is not in 1st column.
           ElseIf cell.Column <> 1 Then
               If cell.Offset(0, -1).Value >= 1 Then
                   cell.Value = cell.Offset(0, -1).Value + 1
                   ' Stop when the last day of the month has been
                   ' entered.
                   If cell.Value > (FinalDay - StartDay) Then
                       cell.Value = ""
                       ' Exit loop when calendar has correct number of
                       ' days shown.
                       Exit For
                   End If
               End If
           ' Do only if current cell is not in Row 3 and is in Column 1.
           ElseIf cell.Row > 3 And cell.Column = 1 Then
               cell.Value = cell.Offset(-1, 6).Value + 1
               ' Stop when the last day of the month has been entered.
               If cell.Value > (FinalDay - StartDay) Then
                   cell.Value = ""
                   ' Exit loop when calendar has correct number of days
                   ' shown.
                   Exit For
               End If
           End If
       Next
       ' Create Entry cells, format them centered, wrap text, and border
       ' around days.
       For x = 0 To 5
           With Range("A4:G4").Offset(x, 0)
               .HorizontalAlignment = xlCenter
               .VerticalAlignment = xlTop
               .WrapText = True
               .Font.Size = 9
               .Font.Bold = False
               ' Unlock these cells to be able to enter text later after
               ' sheet is protected.
               .Locked = False
           End With
           ' Put border around the block of dates.
           With Range("A3").Offset(x, 0).Resize(, _
           7).Borders(xlLeft)
               .Weight = xlHairline
               .ColorIndex = xlAutomatic
           End With
           With Range("A3").Offset(x, 0).Resize(, _
           7).Borders(xlRight)
               .Weight = xlHairline
               .ColorIndex = xlAutomatic
           End With
           Range("A3").Offset(x, 0).Resize(, 7).BorderAround _
              Weight:=xlHairline, ColorIndex:=xlAutomatic
       Next
       If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
          .Resize(, 8).EntireRow.Delete
       ' Turn off gridlines.
       ActiveWindow.DisplayGridlines = True
       ' Protect sheet to prevent overwriting the dates.
       ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
          Scenarios:=False
       ' Resize window to show all of calendar (may have to be adjusted
       ' for video configuration).
       ActiveWindow.WindowState = xlMaximized
       ActiveWindow.ScrollRow = 1
       ' Allow screen to redraw with calendar showing.
       Application.ScreenUpdating = True
       ' Prevent going to error trap unless error found by exiting Sub
       ' here.
       Exit Sub
   ' Error causes msgbox to indicate the problem, provides new input box,
   ' and resumes at the line that caused the error.
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")
       If MyInput = "" Then Exit Sub
       Resume
End Sub
 
Upvote 0
Brian, thanks for suggestion. I think it is better but when i try click error show in cell instead of cell..
Where exactly do i enter the date it says ("Enter a new month/year at the top, and the calendar updates.")?

Thanks again. And sorry i didnt check back.
 
Upvote 0
Use it like this.

Select a blank cell, then click the button, and it will draw a new calendar with Novembers date.

Then click on that date, and on the formula bar you will see Novembers date, change the Month and press Enter, and the calendar will update. :)
 
Upvote 0
Brian, the current calendar that was prev created works perfect but when i creat a new calender by clicking somewhere else it gives #NAME? error
'IF(MONTH(DATE(y,m,1))<>MONTH(DATE(y,m,1)-(WEEKDAY(DATE(y,m,1))-1)+{0;1;2;3;4;5}*7+{1,2,3,4,5,6,7}-1),"",DATE(y,m,1)-(WEEKDAY(DATE(y,m,1))-1)+{0;1;2;3;4;5}*7+{1,2,3,4,5,6,7}-1)
When i check the formula it looks like this.
The existing calender created works even when i change the date.
Do i have to use only this calender or can i create a new one?
Even only this is perfect though...
Thanks again
 
Upvote 0
It works fine for me Pedie,

Try adding a new sheet, and on the developer tab choose Macros, and Run MakeCalendar, you can add as many as you want.
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
Would like to make edits to VBA Calendar Code
Replies
8
Views
465
Legacy 352679
L
M
  • Solved
Convert Date Problem
Replies
4
Views
144
Michele317
M
E
  • Question
How can I create a code to calculate first day in the month taking bank holidays away?
Replies
7
Views
135
Eric Penfold
E
R
  • Question
Macro not working after adding two new items
Replies
4
Views
156
myall_blues
myall_blues
A
  • Question
Creating a Calendar for a Month with tasks
Replies
0
Views
173
anuradhagrewal
A

Forum statistics

Threads
1,215,972
Messages
6,128,026
Members
449,414
Latest member
sameri

Share this page

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