Arthur Fuller
fuller.artful at gmail.com
Mon Nov 26 22:10:42 CST 2012
Thanks to your suggestions, I got where I needed to go. In the course of which I dug up and also created a few new functions, presented below. They are a long way from rocket science, but someone might find them useful. Also included are a couple of test procs, one to exercise all the variants on DateAdd() and the other to exercise the new functions I've included. <vba> '--------------------------------------------------------------- Public Sub TestDateAdd() Dim dt As Date dt = Now() Debug.Print "Initial Date: " & dt Debug.Print "Adding 1 year : ", DateAdd("yyyy", 1, dt) Debug.Print "Subtracting 1 year : ", DateAdd("y", -1, dt) Debug.Print "Adding 1 month : ", DateAdd("m", 1, dt) Debug.Print "Subtracting 1 month : ", DateAdd("m", -1, dt) Debug.Print "Adding 1 week : ", DateAdd("ww", 1, dt) Debug.Print "Subtracting 1 week : ", DateAdd("ww", -1, dt) Debug.Print "Adding 1 day : ", DateAdd("d", 1, dt) Debug.Print "Subtracting 1 day : ", DateAdd("d", -1, dt) Debug.Print "Adding 1 hour : ", DateAdd("h", 1, dt) Debug.Print "Subtracting 1 hour : ", DateAdd("h", -1, dt) Debug.Print "Adding 1 minute : ", DateAdd("n", 1, dt) Debug.Print "Subtracting 1 minute: ", DateAdd("n", -1, dt) Debug.Print "Adding 1 second : ", DateAdd("s", 1, dt) Debug.Print "Subtracting 1 second: ", DateAdd("s", -1, dt) End Sub '--------------------------------------------------------------- Public Sub TestNewDateFuncs() Dim dt As Date dt = Now() Debug.Print "Initial Date: " & dt Debug.Print "Beg of Year : ", BoY(dt) Debug.Print "End of Year : ", EoY(dt) Debug.Print "Beg of Month: ", BoM(dt) Debug.Print "End of Month: ", EoM(dt) Debug.Print "Beg of Week (Default) : ", BoW(dt) Debug.Print "End of Week (Default) : ", EoW(dt) Debug.Print "Beg of Week (Business): ", BoW(dt, True) Debug.Print "End of Week (Business): ", EoW(dt, True) End Sub </vba> In a new module called DateFunctions... <vba> '--------------------------------------------------------------- ' Name : Date Functions ' Author : Arthur Fuller ' Purpose : A collection of date-handling functions ' Notes: ' '--------------------------------------------------------------- Option Compare Database Option Explicit '--------------------------------------------------------------- ' Name: BoM() ' Purpose: Returns the beginning of month for specified date ' Notes: '--------------------------------------------------------------- Public Function BoM(dt As Date) As Date BoM = dt - Day(dt) + 1 End Function '--------------------------------------------------------------- ' Name: EoM() ' Purpose: Returns the end of month for specified date ' Notes: '--------------------------------------------------------------- Public Function EoM(dt As Date) As Date EoM = DateAdd("m", 1, BoM(dt)) - 1 End Function '--------------------------------------------------------------- ' Name: BoY() ' Purpose: Returns the first date of the year for specified date '--------------------------------------------------------------- Public Function BoY(dt As Date) As Date Dim iMonths As Integer iMonths = -(Month(dt) - 1) Debug.Print BoM(DateAdd("m", iMonths, Date)) 'DateAdd("m", 1, BoM(dt)) - 1 BoY = BoM(DateAdd("m", iMonths, Date)) 'DateAdd("m", 1, BoM(dt)) - 1 ' BoY = BoM(DateAdd("m", -(Month(dt) - 1), Date)) 'DateAdd("m", 1, BoM(dt)) - 1 End Function '--------------------------------------------------------------- ' Name: EoY() ' Purpose: Returns the last date of the year for specified date '--------------------------------------------------------------- Public Function EoY(dt As Date) As Date Dim iMonths As Integer iMonths = 12 - Month(dt) Dim dtTemp As Date dtTemp = DateAdd("m", iMonths, dt) EoY = EoM(DateAdd("m", 12 - Month(dt), Date)) 'DateAdd("m", 1, BoM(dt)) - 1 End Function '--------------------------------------------------------------- ' Name: BoW() ' Purpose: Returns the first date of the week for specified date ' Notes: ' Some think the week begins on Sunday, others Monday ' The default is Sunday; the optional parameter overtides this '--------------------------------------------------------------- Public Function BoW(dt As Date, Optional bolOver As Boolean) As Date Dim dtTemp As Date Dim iDays As Integer iDays = -(Weekday(dt) - 1) dtTemp = DateAdd("d", iDays, Date) If bolOver = True Then dtTemp = dtTemp + 1 BoW = dtTemp End Function '--------------------------------------------------------------- ' Name: EoW() ' Purpose: Returns the last date of the week for specified date ' Notes: ' Some think the week begins on Sunday, others Monday ' The default is Sunday; the optional parameter overtides this '--------------------------------------------------------------- Public Function EoW(dt As Date, Optional bolOver As Boolean) As Date Dim dtTemp As Date dtTemp = DateAdd("d", 7 - Weekday(dt), dt) If bolOver = True Then dtTemp = dtTemp + 1 EoW = dtTemp End Function </vba> -- Arthur Cell: 647.710.1314 Prediction is difficult, especially of the future. -- Niels Bohr