Making a calendar in Excel 15

[Zelandakh]

You key in June 2002 into a cell. Or whatever month you like.

Across the top is puts the month. Under that is Sunday, Monday, ..., Saturday (always this order).
Under those, Excel works out where to put 1, 2, 3 etc up to the right number of days for the month.

Each week should be on a row, there should be 5 blank rows between weeks and conditional formatting to hide the days at the end of the month is allowed.

So I have the days from 1st of month in a column, I know I need a weekday() function and I know it can't be THAT difficult.

I'm just having a mental block...someone tell me its Friday!!!!

 

[xlhelp]

The code below is directly from Mr Gates and his folks. I have a couple of example of doing it manually. (I am a masochist at heart.) But, they are at home. So, if you really really want those, please post again and I will try to find them. And if I am not mistaken one of those examples and blank regions to input appointments etc.

You might also want to visit John Walkenbach at

http://www.j-walk.com

HTH

Indu

Here is the code:

Sub CalendarMaker()

' Unprotect sheet if had previous calendar to prevent error.
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
Scenarios:=False
' Prevent screen flashing while drawing calendar.
Application.ScreenUpdating = False
' Set up error trapping.
On Error GoTo MyErrorTrap
' Clear area a1:g14 including any previous calendar.
Range("a1:g14&quot.Clear
' Use InputBox to get desired month and year and set variable
' MyInput.
MyInput = InputBox("Type in Month and year for Calendar &quot
' 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)
' 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 = DateValue(Month(StartDay) & &quot;/1/&quot; & _
Year(StartDay))
End If
' Prepare cell for Month and Year as fully spelled out.
Range(&quot;a1&quot.NumberFormat = &quot;mmmm yyyy&quot;
' Center the Month and Year label across a1:g1 with appropriate
' size, height and bolding.
With Range(&quot;a1:g1&quot
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Font.Size = 18
.Font.Bold = True
.RowHeight = 35
End With
' Prepare a2:g2 for day of week labels with centering, size,
' height and bolding.
With Range(&quot;a2:g2&quot
.ColumnWidth = 11
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.Font.Size = 12
.Font.Bold = True
.RowHeight = 20
End With
' Put days of week in a2:g2.
Range(&quot;a2&quot = &quot;Sunday&quot;
Range(&quot;b2&quot = &quot;Monday&quot;
Range(&quot;c2&quot = &quot;Tuesday&quot;
Range(&quot;d2&quot = &quot;Wednesday&quot;
Range(&quot;e2&quot = &quot;Thursday&quot;
Range(&quot;f2&quot = &quot;Friday&quot;
Range(&quot;g2&quot = &quot;Saturday&quot;
' Prepare a3:g7 for dates with left/top alignment, size, height
' and bolding.
With Range(&quot;a3:g8&quot
.HorizontalAlignment = xlRight
.VerticalAlignment = xlTop
.Font.Size = 18
.Font.Bold = True
.RowHeight = 21
End With
' Put inputted month and year fully spelling out into &quot;a1&quot;.
Range(&quot;a1&quot.Value = Application.Text(MyInput, &quot;mmmm yyyy&quot
' 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 &quot;1&quot; in cell position of the first day of the chosen
' month based on DayofWeek.
Select Case DayofWeek
Case 1
Range(&quot;a3&quot.Value = 1
Case 2
Range(&quot;b3&quot.Value = 1
Case 3
Range(&quot;c3&quot.Value = 1
Case 4
Range(&quot;d3&quot.Value = 1
Case 5
Range(&quot;e3&quot.Value = 1
Case 6
Range(&quot;f3&quot.Value = 1
Case 7
Range(&quot;g3&quot.Value = 1
End Select
' Loop through range a3:g8 incrementing each cell after the &quot;1&quot;
' cell.
For Each cell In Range(&quot;a3:g8&quot
RowCell = cell.Row
ColCell = cell.Column
' Do if &quot;1&quot; 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 = &quot;&quot;
' 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 = &quot;&quot;
' 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(&quot;A4&quot.Offset(x * 2, 0).EntireRow.Insert
With Range(&quot;A4:G4&quot.Offset(x * 2, 0)
.RowHeight = 65
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Font.Size = 10
.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(&quot;A3&quot.Offset(x * 2, 0).Resize(2, _
7).Borders(xlLeft)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Range(&quot;A3&quot.Offset(x * 2, 0).Resize(2, _
7).Borders(xlRight)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Range(&quot;A3&quot.Offset(x * 2, 0).Resize(2, 7).BorderAround _
Weight:=xlThick, ColorIndex:=xlAutomatic
Next
If Range(&quot;A13&quot.Value = &quot;&quot; Then Range(&quot;A13&quot.Offset(0, 0) _
.Resize(2, 8).EntireRow.Delete
' Turn off gridlines.
ActiveWindow.DisplayGridlines = False
' Protect sheet to prevent overwriting the dates.
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True
' 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 &quot;You may not have entered your Month and Year correctly.&quot; _
& Chr(13) & &quot;Spell the Month correctly&quot; _
& &quot; (or use 3 letter abbreviation)&quot; _
& Chr(13) & &quot;and 4 digits for the Year&quot;
MyInput = InputBox(&quot;Type in Month and year for Calendar&quot
If MyInput = &quot;&quot; Then Exit Sub
Resume
End Sub

 

[iGrant]

OK - I think I've created what you require. Doesn't use any code, just some 'if' formulas, some date functions, and some date formatting. The dates that appear in the calendar can be formatted as '01, 02, ...' or as the full date '01/06/02' (in the UK!) or '01-Jun' or however you like. The spreadsheet still works fine.

No conditional formatting to hide dates beyond the end of the month, although it would have been as good a solution.

How can I get the spreadsheet to you? - let me know your mail address.

 

[Zelandakh]

I'm going to try both the Bill version courtesy of XLHelp and iGrant's spreadsheet (please send to zel@zelandakh.co.uk) and I'll report back which one takes my fancy.

So its iGrant against Bill Gates. Who will be the Excel spreadsheet maker of the week?

Place your bets now!

 

[Zelandakh]

Mr Gates gets points for everything working correctly - it puts the calendar into cell A1. Works nicely but not very customisable.

Ian's version is neat, simple, easy to customise the colours or add more rows between the dates.

Ian wins hands down and my users are well impressed! Nice one!

 

[iGrant]

Zelandakh

Glad that the file worked well - thanks for your kind words. It's not every day that you get to beat Mr Gates. Now, if I could just amass, say, $100bn, then I could consider victory mine. So, just $100bn to go...

Happy to share the file - I'll e-mail it to you now, Ang0.

 

[AngO]

iGrant,
Thank you for the wonderful file. I will put it to good use!!
AngO

 

[RSi2]

Make a FAQ with the code.
10x

 

[RSi2]

Publish the code into the FAQ section.
10x

 

[mbarron]

Here is a fairly basic perpetual calendar. (I know it's not in the form that was originally requested)

íf the image didn't load, you can see it here.

http://www.geocities.com/vonbarron1/calendar/calendar.jpg

If you want a copy:

http://www.geocities.com/vonbarron1/calendar/calendar.zip

or

http://www.geocities.com/vonbarron1/calendar/calendar.xls

Mike

 

[mbarron]

I apologize if the image link didn't work. You should be able to see it here:

http://www.geocities.com/vonbarron1/index.htm

tbrock and sago, yours have been sent. Mike

 

[mbarron]

I've added the links to the files here

http://www.geocities.com/vonbarron1/index.htm

Mike

 

[tbrock]

Ian,

Your attachment showed but wasn't there. Berton enabled me to get a copy which is now posted here: www.brockly.biz/iGrant.zip

I also posted mbarron's calendar here: www.brockly.biz/mbarron.zip

I'll leave these posted for approximately a month. Downloaders please be mindful of my limited bandwidth.

-Tom

 

[iGrant]

Thanks, Tom - very helpful of you to post the files.

IG

 

[Guest_imported]

Many thanks Mike. This is highly appreciated.

Sago

 

[mbarron]

To anyone who downloaded my spreadsheet, please change cell C10 to =IF(ISERROR(MONTH($J$7+B10+1)),&quot;&quot;,IF(MONTH($J$7)<>MONTH($J$7+B10),&quot;&quot;,B10+1))

The section in blue currently reads ($J$7+B10+1)

Without the change, months having 31 day, starting on a Saturday, will not display the 31st of the month. I apologize for not checking this factor.

I've updated the file I've reference in my previous post and will send an updated one to tbrock for his site.

Mike

 

[Dreamboat]

Ian:

I'd LOVE to put your calendar on my free downloads page! PUHLEEEEEEEZE!!!!

http://www.thewordexpert.com/downloads.htm

And I will even give you a link where you can look to see how often it is downloaded! Of course, your name and any other info would appear as you desire! This will save you emailing time, etc., and give my audience yet another free download. You and anyone else can always provide the bookmark when ever you like. I'll post back here with the bookmark if Ian agrees and as soon as I get it uploaded. Anne Troy
Dreamboat@TheWordExpert.com
Anne@MrExcel.com

 

[tbrock]

Dreamboat,

I currently (with Ian's blessing) have the calendar posted here:

http://www.brockly.biz/iGrant.zip

It will be there for another few weeks. I'm sure he won't mind you posting it.

Tom

 

[Dreamboat]

Terrific! THANKS! Anne Troy
Dreamboat@TheWordExpert.com
Anne@MrExcel.com

 

[BakeMan]

Has anyone tried to do this perpetual calendar in an Access report? I am trying to get information on training classes stored in an Access database to print on a report that is formatted like a calendar. Any ideas?!?

Thanks in advance