PDA

View Full Version : Solved: Calculating current period / week based on current date



Adaytay
08-19-2004, 07:16 AM
Hi folks... :hi:

Got a bit of a mental block on this one. Wonder if anyone has any ideas or has had to do anything similar with their projects and has any info they would be willing to share?

What I want:
To create a function to calculate the current period and week number based on the current date, for any given date on any given year.

What I know:
The year is split into 12 periods.
Periods 3, 6, 9 and 12 have 5 7-day weeks, while the others have 4 7-day weeks. This is a total of 364 days per financial year.
1st April should always be in Week 1, Period 1.
To stop the start of the year rolling back by a day or two every year, if the end of that fiscal year is due to end on 24th or 25th March, an extra week is added to period 12 - this normally happens roughly every 6 years.
The financial year (period and weeks, too) always start on a sunday and end on a saturday.

--
I'd love to be able to enter a date and have the system tell me which week and which period the date is in. But both myself and one of the other guys in the office are having a complete brain-freeze on this.

Anyone give me any pointers?

Ad

TonyJollans
08-20-2004, 03:48 AM
Hi Ad,

A little bit of messing about and I got this. Can't help feeling I've made it more complicated than it needs to be but it does appear to work although I haven't exhaustively tested it.


Type WeekDetails
iPeriod As Integer
iWeek As Integer
End Type

Sub Test()
Dim dteIn As Date
Dim Temp As WeekDetails

dteIn = #4/1/2004#
Temp = GetWeekDetails(dteIn)

MsgBox dteIn & " is in Period " & Temp.iPeriod & ", Week " & Temp.iWeek

End Sub

Function GetWeekDetails(dteIn As Date) As WeekDetails
Dim dteApr1 As Date
Dim dteStartWeek1 As Date

Dim iWeekInYear As Integer
Dim iWeekInQuarter As Integer
Dim iWeekInPeriod As Integer
Dim iQuarter As Integer
Dim iPeriod As Integer

dteApr1 = DateSerial(Year(dteIn), 4, 1)
dteStartWeek1 = dteApr1 - Weekday(dteApr1, vbSunday) + 1
If dteIn < dteStartWeek1 Then
dteApr1 = DateSerial(Year(dteIn) - 1, 4, 1)
dteStartWeek1 = dteApr1 - Weekday(dteApr1, vbSunday) + 1
End If

iWeekInYear = DateDiff("d", dteStartWeek1, dteIn) \ 7 + 1
iQuarter = IIf(iWeekInYear = 53, 4, (iWeekInYear - 1) \ 13 + 1)
iWeekInQuarter = iWeekInYear - (iQuarter - 1) * 13
iPeriod = IIf(iWeekInQuarter > 8, 3, iWeekInQuarter \ 4 + 1) + (iQuarter - 1) * 3
iWeekInPeriod = iWeekInQuarter - ((iPeriod - 1) Mod 3) * 4

GetWeekDetails.iPeriod = iPeriod
GetWeekDetails.iWeek = iWeekInPeriod

End Function

Adaytay
08-20-2004, 06:52 AM
Thanks Tony :D Didn't quite work properly however...

...but someone at another forum has come up trumps with the following, which has been slightly "tweaked" for use in my DB, as well as for use by Excel:

Public Function GetFinancialPeriod(dtDate As Date) As String

'DESCRIPTION / PURPOSE
'This function takes as a single required argument a date and will return a period and week number
'for the DC financial calendar. See Notes for the assumptions of this financial calendar
'
'INPUTS:
'1. A date (as the variable dtDate), representing the date for which the user wants to know the
' period and week number to which this date belongs.
'
'OUTPUTS:
'1. The period and week number of the input date as a string.
'
'NOTES:
'The financial calendar operates under these assumptions:
'1. The first day of the financial calendar is a Sunday.
'2. If 25 March of a given year is a Sunday, then 2 April is the start of the new financial year.
'3. If 25 March is NOT a Sunday, then the closest Sunday preceding or equalling 1 April is
' the first day of the financial calendar
'4. Weeks are 7 days in length.
'5. There are 12 periods per calendar year
'6. Periods 3, 6, and 9 are composed of 5 weeks.
'7. Periods 1-2, 4-5, 7-8, 10-11 are composed of 4 weeks.
'8. Normally, week 12 is 5 weeks. However, in the event 24 or 25 March is set to be the last
' day under this rule, then an extra week is added to Period 12 for a total of 6 weeks.

Dim lngDayDifference As Long, lngPeriodNumber As Long, lngWeekNumber As Long
Dim dtFirstDayOfFinancialYear As Date

'If 25 March of this year is Sunday, then 2 April is actually the first day of the financial year
If Weekday(CDate("25-Mar-" & Year(dtDate))) = vbSaturday Then
dtFirstDayOfFinancialYear = CDate("2-Apr-" & Year(dtDate))
Else
dtFirstDayOfFinancialYear = DateAdd("d", 1 - Weekday(CDate("1-Apr-" & Year(dtDate))), _
CDate("1-Apr-" & Year(dtDate)))
End If

If dtDate >= dtFirstDayOfFinancialYear Then
lngDayDifference = DateDiff("d", dtFirstDayOfFinancialYear, dtDate) + 1
Else
'If 25 March is Sunday, then 2 April is actually the first day of the financial year
If Weekday(CDate("25-Mar-" & Year(dtDate) - 1)) = vbSaturday Then
dtFirstDayOfFinancialYear = CDate("2-Apr-" & Year(dtDate) - 1)
Else
dtFirstDayOfFinancialYear = DateAdd("d", 1 - Weekday(CDate("1-Apr-" & Year(dtDate) - 1)), CDate("1-Apr-" & Year(dtDate) - 1))
End If
lngDayDifference = DateDiff("d", dtFirstDayOfFinancialYear, CDate("31-Dec-" & Year(dtDate) - 1)) + _
DateDiff("d", CDate("1-Jan-" & Year(dtDate)), dtDate) + 2
End If

lngPeriodNumber = 1
lngWeekNumber = 0
Do
lngWeekNumber = lngWeekNumber + 1
If lngWeekNumber = 6 And lngPeriodNumber < 12 Then
lngWeekNumber = 1
lngPeriodNumber = lngPeriodNumber + 1
ElseIf lngWeekNumber = 5 And Not (lngPeriodNumber = 3 Or lngPeriodNumber = 6 Or _
lngPeriodNumber = 9 Or lngPeriodNumber = 12) Then
lngWeekNumber = 1
lngPeriodNumber = lngPeriodNumber + 1
End If
lngDayDifference = lngDayDifference - 7 'always 7 days in a week
Loop While lngDayDifference > 0

'Optional Output for Excel - uncomment if not required...
GetFinancialPeriod = "Period " & lngPeriodNumber & ", Week " & lngWeekNumber

'Optional Output for Access - use ParseArgString function to recover information - uncomment if necessary
strFinancialPeriod = "&Period=" & lngPeriodNumber & "&Week=" & lngWeekNumber

End Function

Just in case anyone ever needs a similar function....

Ad