Along the lines of Paul's comment, could you have a table with
period StartDate PeriodEnd
for as many years as practical (5 back/5 future)
Hi Orange Thanks very much for the reply and your work on this code!
I really only need the dating for the previous 13 periods, as well as the dates for each period in the current year relative to the users current date.
I would like to avoid using a table as I mentioned in my reply to Welshgasman but I did play with your code and if there is no function to be had, I believe your method will be the way to go so Thank you kindly.
I was thinking in that case, I would be better off not having a hard coded start date, but add a dStartDateSeed field to my already linked Parameters table and maybe having that field updated during year end processing to reflect the start date of the 1st period of the previous year, That way, if management does decide to reset the periods due the creep mentioned by Ajax, there is someplace for them to do that without requiring someone get into the code. Using your code, I am looking at something like this
[code]
Sub ReportingPeriodsTest()
'skeleton to populate a table with
'28 day reporting periods from 2017 to 2027
Dim StartDate As Date
Dim dStartDateSeed As Date
Dim Periodlen As Integer
Dim periodEnd As Date
dStartDateSeed = CDate(DLookup("dStartDateSeed", "Parameters")) ' single record table so no qualifier needed
StartDate = dStartDateSeed
Periodlen = 27
Dim i As Integer
i = 1
Do Until StartDate > DateAdd("yyyy", 3, dStartDateSeed)
' Do Until StartDate > #12/30/2027#
periodEnd = DateAdd("d", Periodlen, StartDate)
Debug.Print i, StartDate, periodEnd 'for testing (could write to a table)
StartDate = periodEnd + 1
i = i + 1
If i > 13 Then i = 1
Loop
End Sub
[code/]
The downside would be that someone would have to run the code to update the TblReportingPeriods each year.
Code:
'Updated the code and included a query:
'Create a table:
Sub ReportingPeriods()
On Error GoTo ReportingPeriods_Error
'skeleton to populate a table with
'28 day reporting periods from 2021 to 2024
Dim cSQL As String, Cinsert As String
'On Error Resume Next
CurrentDb.Execute "drop table TblReportingPeriods;"
cSQL = "Create Table TblReportingPeriods (" _
& "PK AUTOINCREMENT PRIMARY KEY" _
& ",Period integer " _
& ",StartDate Date " _
& ",PeriodEnd Date " _
& ",constraint UX_Start unique(StartDate ) " _
& ");"
Cinsert = "INSERT INTO TblReportingPeriods(Period,StartDate,PeriodEnd) VALUES("
Debug.Print cSQL
CurrentDb.Execute cSQL, dbFailOnError
Dim StartDate As Date
Dim dStartDateSeed As Date
Dim Periodlen As Integer
Dim periodEnd As Date
dStartDateSeed = CDate(DLookup("dStartDateSeed", "Parameters")) ' single record table so no qualifier needed
StartDate = dStartDateSeed
'StartDate = #1/2/2021#
Periodlen = 27
Dim i As Integer
i = 1
Do Until StartDate > DateAdd("yyyy", 3, dStartDateSeed)
'Do Until StartDate > #12/24/2030#
periodEnd = DateAdd("d", Periodlen, StartDate)
Debug.Print i, StartDate, periodEnd
'Debug.Print Cinsert & i & ",#" & StartDate & "#,#" & periodEnd & "#)"
CurrentDb.Execute Cinsert & i & ",#" & StartDate & "#,#" & periodEnd & "#)", dbFailOnError
StartDate = periodEnd + 1
i = i + 1
If i > 13 Then i = 1
Loop
On Error GoTo 0
ReportingPeriods_Exit:
Exit Sub
ReportingPeriods_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ReportingPeriods, line " & Erl & "."
GoTo ReportingPeriods_Exit
End Sub
'
Updated the code and included a query:
Query:
PARAMETERs myDateMMDDYYYY date;
SELECT Period,TblReportingPeriods.StartDate, TblReportingPeriods.PeriodEnd
FROM TblReportingPeriods
where startDate <=myDateMMDDYYYY and PeriodEnd>= myDateMMDDYYYY