Fiscal calendars not at normal end of months

[JordanCN2]

Our company switched from standard end of months (1/31, 2/28, etc) to a quarterly fiscal calander where the months are divided up into 5-4-4 weeks (13 weeks each) for the 4 quarters. Here is an End Of Month table:

Table Name = EOM

Year Month Quarter StartDate EndDate
2011 Jan 1 1/1/2011 2/4/2011
2011 Feb 1 2/5/2011 3/4/2011
2011 Mar 1 3/5/2011 4/1/2011
2011 Apr 2 4/2/2011 5/6/2011
2011 May 2 5/7/2011 6/3/2011
2011 Jun 2 6/4/2011 7/1/2011
2011 Jul 3 7/2/2011 8/5/2011
2011 Aug 3 8/6/2011 9/2/2011
2011 Sep 3 9/3/2011 9/30/2011
2011 Oct 4 10/1/2011 11/4/2011
2011 Nov 4 11/5/2011 12/2/2011
2011 Dec 4 12/3/2011 12/31/2011

I have to translate due dates, order dates, etc into the Fiscal months and quarters, however I am having trouble writing an efficient function that will determine what Year, Month and Quarter a date is in.

 

[dhookom]

I would consider creating a table of all dates. Include columns for the Fiscal month, quarter, and year. While these might be easy to calculate, the table of dates might be the most efficient. The 'Date' field should be the primary key. I would create this in Excel and then paste into Access.

Duane
Hook'D on Access
MS Access MVP

 

[vbajock]

You see this in a lot of ERP systems. Usually there is a key called "Period", which is a number from 1 to 12 that corresponds to the month. Once you have the table keyed that way, you can use the Month function on any date you encounter in Dlookups on the table and get the quarter or beginning date and the ending date of the period like

iQuarter=Dlookup("Quarter","my544table","Period = " & Str$(Month(SomeDateValue))

dBegindate=Dlookup("StartDate","my544table","Period = " & Str$(Month(SomeDateValue))

etc

 

[JordanCN2]

I don't think that will work because the EOM usually ends in the next month. For example our month end for January was Friday Feb 4. If I use your function above:

Month(#2/4/2011#) is Feb. The lookup will check for Period "Feb", not "Jan".

I did manage to find a function written by Jeff Lehn here:

http://www.ozgrid.com/forum/showthread.php?t=50047&page=1

However the problem with the code is on the year ends. It will check for the first full week starting on a Monday and start the calendar from there. In his code, January 1 and 2 of this year are part of Week 52 of 2010.

I suppose Dhookom has the simplest idea which is usually the best.

 

[vbajock]

Yes, you are right, I went back and looked at how it worked, and you need a table that lists all 365 days of the year and the corresponding periods and start and end dates. You have to write some code to fill the table based on the starting date. You enter the start date and it fills the table out in a "perpetual calendar". It's been a long time since I wrote it, I'm trying to find it and I will post it as soon as I do.

 

[MichaelRed]

Creating a / the calendar table is relatively easy in MS Access. A few threads in htese (Tek-Tips) fora reference (and provide links to) extensive discussions of the structure, creation and population.

I have 'translated' some of the discussion functions:

Option Compare Database
Function SetRecValues(Date1 As Date, Date2 As Date)

'    ? SetRecValues(#12/13/2010#, #12/15/2010#)

    DoCmd.SetWarnings False

    Dim FirstDate As Date
    Dim EndDate As Date
    Dim RecordNo As Long
    Dim ChangeType As String

    Dim strSQ As String
    strSQL = "INSERT INTO tblMonth (RecordNo, Date, Status) VALUES ("


'   FirstDate = Me.Date1
'   EndDate = Me.Date2

    FirstDate = Date1
    EndDate = Date2


    RecordNo = 1
    ChangeType = "A"
'    ChangeType = cboTipoCambio.Value

    Do While RecordNo <= 366
        dtTempDate = FirstDate

        Do While FirstDate <= EndDate
            If ((Weekday(FirstDate <> vbSaturday)) And (Weekday(FirstDate <> vbSunday))) Then
'               DoCmd.RunSQL strSQL & RecordNo & ",#" & Format FirstDate "mm/dd/yyyy") _
                                               & "#," & ChangeType & ")"
            End If


            Debug.Print strSQL & RecordNo & ", #" & Format(FirstDate, "mm/dd/yyyy") _
                               & "#," & ChangeType & ")" _
                               & FirstDate, WeekdayName(Weekday(FirstDate))

            FirstDate = DateAdd("d", 1, FirstDate)
        Loop

        FirstDate = DateAdd("d", 1, Date1)
        RecordNo = RecordNo + 1
    Loop

End Function
Public Function basWeeksInYear(intYear As Integer, WeekDayStart As Integer) As Integer

    'Just determine the number of "Weeks" in the year
    '? basWeeksInYear(2010, vbMonday) returns 52

    Dim intWeeksInYear As Integer
    basWeeksInYear = DateDiff("w", (DateSerial(intYear, 1, 1)), (DateSerial(intYear + 1, 1, 1)), WeekDayStart)
    

    'Debug.Print intWeeksInYear

End Function
Public Function basMakeCalendar()

    Dim dba As Database
    Set dbs = CurrentDb
    
    dbs.Execute "Create Table tblCalendar " _
                 & _
                 "(dt Date Primary Key, " _
                 & "IsWeekDay Integer, " _
                 & "IsHoliday Integer, " _
                 & "FY Integer, " _
                 & "Q Integer, " _
                 & "M Integer, " _
                 & "DW Integer, " _
                 & "MonthName Text (9), " _
                 & "W Integer, " _
                 & "UTC_Offset Integer Not Null);"

'               'Should have added Hopliday Name / Description to This?

    dbs.Close

End Function
Public Function basPopulateCalendar()

    'Populate the Calendar w/ Records
    '? basPopulateCalendar _
     Start @ 1/8/2011 10:20:15 PM _
     End @ 1/8/2011 10:20:19 PM


    Dim dbs As DAO.Database
    Set dbs = CurrentDb

    Dim strSQL As String
    Dim strSQLValues As String
    strSQL = "Insert Into tblCalendar (dt, UTC_Offset) Values "

    Dim dt4Calendar As Date
    Dim Add As Integer
    intAdd = 0

    Debug.Print "Start @ " & Now

    While intAdd <= 10957
        dt4Calendar = DateAdd("d", intAdd, #1/1/2011#)
        strSQLValues = "(#" & dt4Calendar & "#, 5);"
        dbs.Execute strSQL & strSQLValues
        intAdd = intAdd + 1
    Wend

    Debug.Print "End @ " & Now

End Function
Public Function basCalcFields()

    '? basCalcFields _
     Start @ 1/9/2011 11:17:37 AM _
     End @ 1/9/2011 11:17:38 AM

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Set dbs = CurrentDb

    Set rst = dbs.OpenRecordset("tblCalendar", dbOpenDynaset)

    Debug.Print "Start @ " & Now

    With rst
        While .EOF = False
            .Edit
                'Determine and SetWorkDay
                If (Weekday(rst!dt) <> vbSunday And Weekday(!dt) <> vbSaturday) Then
                    !IsWeekDay = True
                 Else
                    !IsWeekDay = False
                End If
    
                'Initalize Holiday Status as False!  Correct Later
                !IsHoliday = False
    
                'Get the date parts seperated
                !Y = Year(!dt)
                !M = Month(!dt)
                !MonthName = MonthName(Month(!dt))
                !D = Day(!dt)
                !DayName = WeekdayName(Weekday(!dt))
                !FY = Year(!dt)
    
                'Set the Quarter
                Select Case Month(!dt)
                    Case Is < 4
                        !Q = 1
                    Case Is < 7
                        !Q = 2
                    Case Is < 9
                        !Q = 3
                    Case Else
                        !Q = 4
                End Select
    
                'Numerical Day of the Week
                !DW = Weekday(!dt)
    
                'Week of the Year
                !W = DatePart("WW", !dt)
    
                'Wimp Holidays (only the Constants and Easy ones)
                'Christmas
                If (Month(!dt) = 12 And Day(!dt) = 25) Then
                    !IsHoliday = True
                    !HolidayName = "Christmas"
                End If

                'New Years Day
                If (Month(!dt) = 1 And Day(!dt) = 1) Then
                    !IsHoliday = True
                    !HolidayName = "New Years"
                End If

                'Independence Day
                If (Month(!dt) = 7 And Day(!dt) = 4) Then
                    !IsHoliday = True
                    !HolidayName = "Independence Day"
                End If
            .Update
        .MoveNext
    Wend
    
    End With

    Debug.Print "End @ " & Now

End Function
Public Function basMemorialday()

    'Memorial Day.  Last Monday in May
    Dim dbs As DAO.Database
    Set dbs = CurrentDb

    Dim rst As DAO.Recordset
    Set rst = dbs.OpenRecordset("qryLastDayInMay")

    Dim rstUpdate As DAO.Recordset
    Set rstUpdate = dbs.OpenRecordset("tblCalendar", dbOpenDynaset)

    Dim dtMemDate As Date
    Dim dtThanksgiving As Date
    Dim strCriteria As String

    With rst
        While .EOF = False
            dtMemDay = DateAdd("d", -Weekday(!dt), !dt)
            strCriteria = "dt = " & "#" & dtMemDay & "#"
            rstUpdate.FindFirst strCriteria
            rstUpdate.Edit
                rstUpdate!IsHoliday = True
                rstUpdate!HolidayName = "Memorial Day"
            rstUpdate.Update
            .MoveNext
        Wend
    End With


End Function
Public Function basVetransDay()

    'Vetrans Day
    Dim dbs As DAO.Database
    Set dbs = CurrentDb

    Dim rst As DAO.Recordset
    Set rst = dbs.OpenRecordset("qryVetransDay")

    With rst
        While .EOF = False
            strCriteria = "dt = " & "#" & !dt & "#"
            rstUpdate.FindFirst strCriteria
            rstUpdate.Edit
                rstUpdate!IsHoliday = True
                rstUpdate!HolidayName = "Vetrans Day"
            rstUpdate.Update
            .MoveNext
        Wend
    End With

End Function
Public Function basThanksgivingDay()

    'Thanksgining Day _
     Fourth Thursday of November

    Dim dbs As DAO.Database
    Set dbs = CurrentDb

    Dim rst As DAO.Recordset
    Set rst = dbs.OpenRecordset("qryLastDayInMay")

    Dim rstUpdate As DAO.Recordset
    Set rstUpdate = dbs.OpenRecordset("tblCalendar", dbOpenDynaset)

    Dim dtMemDate As Date
    Dim dtThanksgiving As Date
    Dim strCriteria As String

    Set rst = dbs.OpenRecordset("qryThanksgiving")
    With rst
        While .EOF = False
            strCriteria = "dt = " & "#" & !Thanksgiving & "#"
            rstUpdate.FindFirst strCriteria
            rstUpdate.Edit
                rstUpdate!IsHoliday = True
                rstUpdate!HolidayName = "Thanksgiving Day"
            rstUpdate.Update
            .MoveNext
        Wend
        
    End With


End Function
Public Function basWeekOfTheMonth()

    'Populate WkOfMnth
    Dim dbs As Database
    Set dbs = CurrentDb

    Dim rst As DAO.Recordset
    Set rst = dbs.OpenRecordset("tblCalendar", dbOpenDynaset)

    'Set the fist day of each month to be Firt Week of the month
    Dim strSQL As String
    strSQL = "UPDATE tblCalendar SET tblCalendar.WkOfMnth = 1 " _
           & "WHERE (((tblCalendar.D)=1));"
    DoCmd.SetWarnings Off
        DoCmd.RunSQL strSQL
    DoCmd.SetWarnings Off

    Dim intIdx As Integer       'Simple Counter for the Week
    Dim intWeek As Integer      'Our Local Week in the month (reset @ 1/mm)
    Dim intMonth As Integer     'Current month in the year
    Dim IntYr As Integer        'CurrentYear

    rst.MoveFirst     'Assure we start @ the beginning

        With rst      'Recordset to update (all Records)

            intIdx = 1          'Init Counter for the (MAX) seven days per week
            intMonth = !M       'Track for the current month
            IntYr = !Y          'Track for the currnet Year
            intWeek = 1

            While .EOF = False  'Do all Records

                'Change of week number criteria
                If (!M <> intMonth) Or (!Y <> IntYr) Then
                    intWeek = 1
                    intIdx = 1
                    intMonth = !M
                    IntYr = !Y
                End If

                rst.Edit
                    !WkOfMnth = intWeek
                rst.Update        'First record is initalized bu setup
                intIdx = intIdx + 1     'Increment number of days in the week
                If (intIdx > 7) Then    'Check for incrementing the Week
                    intIdx = 1
                    intWeek = intWeek + 1
                End If
            
            .MoveNext
            Wend

        End With

End Function
Public Function basContractsQuery()

    Dim strSQL As String
    strSQL = "SELECT c1.ContractID, c1.dt " _
           & "FROM (SELECT " _
                    & "cons.ContractID , cal.dt " _
                    & "FROM dbo.Calendar cal " _
                    & "INNER Join " _
                    & "(SELECT ContractID, dtStart = MIN(dtStart), dtEnd = MAX(dtEnd) " _
                    & "FROM Contracts GROUP BY ContractID) cons " _
                    & "ON cal.dt BETWEEN cons.dtStart AND cons.dtEnd) c1 " _
                    & "LEFT OUTER JOIN " _
                        & "(SELECT cons2.ContractID , cal2.dt " _
                        & "FROM dbo.Calendar cal2 " _
                        & "INNER JOIN dbo.Contracts cons2 " _
                        & "ON cal2.dt BETWEEN cons2.dtStart AND cons2.dtEnd) c2 " _
                        & "ON c1.ContractID = c2.ContractID AND c1.dt = c2.dt " _
                        & "WHERE c2.dt Is Null"

    DoCmd.RunSQL strSQL
End Function
Public Function basSubqueryW_Aggregate()

    Dim strSQL As String
    strSQL = "SELECT COUNT(*) - (SELECT COUNT(*)" _
           & "FROM " _
             & "(SELECT DISTINCT PositionNumber " _
             & "FROM PositionPlacements " _
             & "WHERE PositionType = 'Permanent') D) " _
                & "FROM PositionPlacements " _
                & "WHERE PositionType = 'Permanent'"
End Function

I have foound that including holidays in the calendar does not suit me, as most of the requirements seem to be highly dependant (on the needs / whims ... of the specific organization) are often not known far in advance and subject to change throughoout the period. A simple table of the holidays and their dates of observation is easily joined to the larger table when the holidays are relevant.




MichaelRed

 

[vbajock]

Check out the download on this thread, it probably has the code you are looking for. You have to register to get the download:

http://www.utteraccess.com/forum/4-4-5-week-calendar-t1269961.html

 

[Gruuuu]

I would highly recommend dhookom's solution.

It's very easy to use, implement, and understand.

 

[vbajock]

Here, I found the code, given the table you have:

Public Function GetCorrectPeriod()

Dim period As Integer
Dim quarter As Integer
Dim dStartDate As Date
Dim dEndDate As Date
Dim somedate As String

somedate = "4/1/2011"

dEndDate = DLookup("EndDate", "tblCalendar", "Enddate >= #" & somedate & "# And EndDate <=#" & somedate & "#")
dStartDate = DLookup("StartDate", "tblCalendar", "Enddate >= #" & somedate & "#")

period = DLookup("Period", "tblCalendar", "StartDate >= #" & CStr(dStartDate) & "# And EndDate <=#" & CStr(dEndDate) & "#")
quarter = DLookup("Quarter", "tblCalendar", "StartDate >= #" & CStr(dStartDate) & "# And EndDate <=#" & CStr(dEndDate) & "#")


Debug.Print period
Debug.Print quarter
Debug.Print dStartDate
Debug.Print dEndDate


End Function

If your calendar has multiple years, you need to modify the where clause

 

[vbajock]

Wish this forum had an edit function!

dStartDate = DLookup("StartDate", "tblCalendar", "Enddate >= #" & somedate & "#")

should be

dStartDate = DLookup("StartDate", "tblCalendar", "Enddate = #" & somedate & "#")

 

[vbajock]

and these, same thing

period = DLookup("Period", "tblCalendar", "StartDate >= #" & CStr(dStartDate) & "# And EndDate <=#" & CStr(dEndDate) & "#")

quarter = DLookup("Quarter", "tblCalendar", "StartDate >= #" & CStr(dStartDate) & "# And EndDate <=#" & CStr(dEndDate) & "#")

should be
period = DLookup("Period", "tblCalendar", "StartDate = #" & CStr(dStartDate) & "# And EndDate =#" & CStr(dEndDate) & "#")
quarter = DLookup("Quarter", "tblCalendar", "StartDate = #" & CStr(dStartDate) & "# And EndDate =#" & CStr(dEndDate) & "#")