Consulting

Results 1 to 3 of 3

Thread: Solved: Calculating current period / week based on current date

  1. #1
    VBAX Regular
    Joined
    May 2004
    Location
    Driffield, East Yorkshire, Egnland
    Posts
    69
    Location

    Solved: Calculating current period / week based on current date

    Hi folks...

    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

  2. #2
    VBAX Master TonyJollans's Avatar
    Joined
    May 2004
    Location
    Norfolk, England
    Posts
    2,291
    Location
    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.

    [VBA]
    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

    [/VBA]
    Enjoy,
    Tony

    ---------------------------------------------------------------
    Give a man a fish and he'll eat for a day.
    Teach him how to fish and he'll sit in a boat and drink beer all day.

    I'm (slowly) building my own site: www.WordArticles.com

  3. #3
    VBAX Regular
    Joined
    May 2004
    Location
    Driffield, East Yorkshire, Egnland
    Posts
    69
    Location
    Thanks Tony 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:
    [vba]
    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[/vba]

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

    Ad

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •