Evergoing calendar

[Regouin]

Allright I have another problem,

I want to create a calender that is based on weeks and goes on for 1 year, so it looks like this

Week number starting date ending date
1 03-01-2005 09-01-2005
2 10-01-2005 16-01-2005
3 17-01-2005 23-01-2005
etc...

Now the problem is that some years have 52 and others 53 weeks, now how do i let excel know that a year has 52 or 53 weeks.

next problem is:
after the ending date there are going to be 4 numbers so it is going to look like this:

Week number starting date ending date #1 #2 #3 #4
1 03-01-2005 09-01-2005 100 300 200 350
2 10-01-2005 16-01-2005 300 500 250 130
3 17-01-2005 23-01-2005 330 420 610 350
etc...

Dont worry about the numbers I have a vba script for their input and dont need to do anything with them.
Now what I want is that when the last week of the year is completed

52 26-12-2005 01-01-2006 320 420 430 510

That I can run a macro (which checks if the last blocks are filled) and then copy the sums of the rows, replace the totals on top of the sheet with these sums, clear all the values for the weeknumbers and then start with the new year, so week 1 is going to start with 02-01-2006 and then counts onwards.

i hope you can understand this.

TIA
Frank

[mvidas]

Hi Frank,

I don't quite understand your last part, but here is a macro to create the calendar for you:


Sub regouin()
Dim yr As Integer, SDate As Date, wks As Integer, i As Integer
Dim WB As Workbook, WS As Worksheet
On Error Resume Next
yr = InputBox(Prompt:="Please enter year", Default:=Year(Date))
On Error GoTo 0
If yr = 0 Then Exit Sub
If Not IsDate(DateSerial(yr, 1, 1)) Then Exit Sub
Application.ScreenUpdating = False
Set WB = Workbooks.Add(-4167)
Set WS = WB.Sheets(1)
SDate = DateSerial(yr, 1, 1)
Do Until Weekday(SDate, 2) = 1
SDate = SDate + 1
Loop
If Month(SDate + 364) = 1 Then wks = 52 Else wks = 53
WS.Range("A1:G1") = Array("Week number", "Starting date", "Ending date", "#1", "#2", "#3", "#4")
WS.Range("A2:C2") = Array(1, SDate, SDate + 6)
For i = 2 To wks
WS.Range("A1:C1").Offset(i, 0) = Array(i, SDate + (7 * (i - 1)), SDate + (7 * (i - 1)) + 6)
Next i
WS.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

It creates a new workbook, with just one sheet, for this. If you just want a sheet added to the activeworkbook, change the "Workbooks.Add -4167" to "Sheets.Add".

Let me know if you have any questions!
Matt

[Regouin]

ok thank you for all the work, but when I run the macro as it is (copy paste) then it doesnt work, it generates a new workbook with 1 empty sheet, am I missing something here?

[Regouin]

ok, i figured out the problem, it used the active workbook and not the one generated, so now it sort of screwed up the first sheet of my workbook, luckily there was not much on there.
I'll see if I can find the problem.
frank


mmm, and it isnt accurate on the 52 or 53 weeks, when i tried it for 2004 (which has 53 weeks) the first week started on the fifth of january and not one week earlier as it should. however this is rather complicated material because a year has 53 weeks when the first on january is on a thursday, except when you have a leap-year then it has 53 weeks when the first of january is either on a wednesday or a thursday. Now I have been trying to work around this using excel formulas (so no VBA) but the prerequisites for a leap year are complicated as well. When the year can be divided by 4 it is a leap year, except when it can also be divided by a 100 then it isnt a leap year, except when it can also be divided by 400 then it IS a leap year. You still following my drift?

so i got the following excel scheme worked out to determine whether or not it is a leap year:

A B
1 #year
2 =#year/4 =if(a2=integer(a2);"yes";"no")
3 =#year/100 =if(a3=integer(a3);"yes";"no")
4 =#year/400 =if(a4=integer(a4);"yes";"no")

6 =if(a4="yes";"yes";if(a3="yes";"no";if(=a2="yes";"yes";"no")))

now the formula in a6 should determine whether or not it is a leap year, i tried it and it seems to work fine (for instance, 1900 is not a leap year, 2000 is a leap year, 2004 is a leap year, 2100 is not a leap year, etc.)

now i have tried a little bit with vba to get it to make a calender, but i can't think of a way yet to make it determine the 53 weeks business.

[Regouin]

post can be deleted, post is not relevant anymore

[mvidas]

Hi Frank,

I'm glad you got it solved, though I'm a bit curious as to why the calendar was added to your sheet1 of the activeworkbook instead of the newly created workbook.

I had it setup that the weeks began on a Monday, based on your comment above:

1 03-01-2005 09-01-2005
2 10-01-2005 16-01-2005
3 17-01-2005 23-01-2005

For instance, if the 1st of the year is a Saturday, then that is considered to be part of the last week of the previous year. That is why the macro said that week 1 of 2004 started on 1/5/04.

Although you marked this as solved, I'd still like to help if needed. How do you determine what the first week of the year is?

By the way, I've edited my original VBA to make sure the calendar is created in the new workbook.

[Regouin]

Ok, I will tell you what I've done.
the first week of the year is determined by the first thursday in the new year. Whatever week the first thursday is in (be it 01/01 to 01/06) is going to be the first year.
now another tricky thing is when a year has 52 or 53 weeks, this breaks down as follows. Normally when 01/01 is a thursday, the year has 53 weeks, except when you have a leap year then 01/01 can either be a wednesday or a thursday. Now a leap year is defined as once every 4 years except when it can also be divided by 100 (not a leap year) ecept when it can also be divided by 400 (it is a leap year). The year 2000 for instance is dividable by 4, but also by a 100, but also by 400 (so this is generally the exception on the exception).
Now to determine the first week of the year i have written the following script



Sub Kalender()
'toewijzen variabelen
Dim yr As Integer, WS As Worksheet, SDate As Date, wks As Integer, i As Integer, leap As String, jaar As Integer
On Error Resume Next
'opgeven jaartal
yr = InputBox(Prompt:="Geef jaartal op", Default:=Year(Date))
On Error GoTo 0
If yr = 0 Then Exit Sub
If Not IsDate(DateSerial(yr, 1, 1)) Then Exit Sub
Application.ScreenUpdating = False
'toewijzen jaartal, bepalen schrikkel jaar, aantal weken bepalen
SDate = DateSerial(yr, 1, 1)
jaar = Worksheets("totaal").Range("b1")
Worksheets("totaal").Range("b1").FormulaR1C1 = yr
leap = Worksheets("totaal").Range("l6")
If leap = "ja" Then GoTo schrikkel
If Weekday(SDate) = 5 Then wks = 53 Else wks = 52
Worksheets("totaal").Range("i1").FormulaR1C1 = wks
'begin van week 1 bepalen
If Weekday(SDate) <= 5 Then GoTo doloop1 Else GoTo doloop2
'week 1 begint nog in vorig jaar en het jaar is geen schrikkeljaar
doloop1:
Do Until Weekday(SDate, vbMonday) = 1
SDate = SDate - 1
Loop
Worksheets("totaal").Range("A3:c3") = Array("Week nummer", "Startdatum week", "Einddatum week")
Worksheets("totaal").Range("A4:C4") = Array(1, SDate, SDate + 6)
For i = 2 To wks
Worksheets("totaal").Range("A3:C3").Offset(i, 0) = Array(i, SDate + (7 * (i - 1)), SDate + (7 * (i - 1)) + 6)
Next i
If wks = 52 Then Worksheets("totaal").Range("a56:c56").FormulaR1C1 = ""
Application.ScreenUpdating = True
GoTo einde
'week 1 begint in nieuwe jaar en het jaar is geen schrikkeljaar
doloop2:
Do Until Weekday(SDate, vbMonday) = 1
SDate = SDate + 1
Loop
Worksheets("totaal").Range("A3:c3") = Array("Week nummer", "Startdatum week", "Einddatum week")
Worksheets("totaal").Range("A4:C4") = Array(1, SDate, SDate + 6)
For i = 2 To wks
Worksheets("totaal").Range("A3:C3").Offset(i, 0) = Array(i, SDate + (7 * (i - 1)), SDate + (7 * (i - 1)) + 6)
Next i
If wks = 52 Then Worksheets("totaal").Range("a56:c56").FormulaR1C1 = ""
Application.ScreenUpdating = True
GoTo einde
schrikkel:
'begin van week 1 bepalen
If Weekday(SDate) = 5 Or Weekday(SDate) = 4 Then wks = 53 Else wks = 52
Worksheets("totaal").Range("i1").FormulaR1C1 = wks
If Weekday(SDate) <= 5 Then GoTo doloop3 Else GoTo doloop4
'week 1 begint in het vorige jaar en het jaar is een schrikkeljaar
doloop3:
Do Until Weekday(SDate, vbMonday) = 1
SDate = SDate - 1
Loop
Worksheets("totaal").Range("A3:c3") = Array("Week nummer", "Startdatum week", "Einddatum week")
Worksheets("totaal").Range("A4:C4") = Array(1, SDate, SDate + 6)
For i = 2 To wks
Worksheets("totaal").Range("A3:C3").Offset(i, 0) = Array(i, SDate + (7 * (i - 1)), SDate + (7 * (i - 1)) + 6)
Next i
If wks = 52 Then Worksheets("totaal").Range("a56:c56").FormulaR1C1 = ""
Application.ScreenUpdating = True
GoTo einde
'week 1 begint in het nieuwe jaar en het jaar is een schrikkeljaar
doloop4:
Do Until Weekday(SDate, vbMonday) = 1
SDate = SDate + 1
Loop
Worksheets("totaal").Range("A3:c3") = Array("Week nummer", "Startdatum week", "Einddatum week")
Worksheets("totaal").Range("A4:C4") = Array(1, SDate, SDate + 6)
For i = 2 To wks
Worksheets("totaal").Range("A3:C3").Offset(i, 0) = Array(i, SDate + (7 * (i - 1)), SDate + (7 * (i - 1)) + 6)
Next i
If wks = 52 Then Worksheets("totaal").Range("a56:c56").FormulaR1C1 = ""
Application.ScreenUpdating = True
GoTo einde
einde:
End Sub


now there is another program being run after the calendar has been made, but that is of no importance.
I made excel determine in the workbook whether or not we are dealing with a leap year (see my previous post)


so I have created 4 situations

-not a leap year and the first week starts in the "old" year (12/30/2003 is part of week 1 of 2004)

-not a leap year and the first week starts in the "new" year (01/03/2005 is the first date of week 1 of 2005)

-a leap year and the first week starts in the "old" year (12/30/2003 is part of week 1 of 2004)

-a leap year and the first week starts in the "new" year (01/03/2005 is the first date of week 1 of 2005)

the examples are not for leap years but to illustrates when the first week starts.

hope this clears things up