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>
>