Stuart McLachlan
stuart at lexacorp.com.pg
Mon Nov 26 22:27:56 CST 2012
Alternative (simpler?) functions: Public Function BoM(dt As Date) As Date BoM = DateSerial(year(dt),month(dt),1) End Function Public Function BoY(dt As Date) As Date BoY = DateSerial(year(dt),1,1) End Function Public Function EoY(dt As Date) As Date EoY = Dateserial(year(dt),12,31) End Function Public Function EoM(dt as date) EOM = DateSerial(year(dt),month(dt) +1,1) -1 End Function On 26 Nov 2012 at 23:10, Arthur Fuller wrote: > 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> >