[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More
Experts Exchange Solution brought to you by
"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.
Public Function DateRound( _
ByVal datDate As Date, _
Optional ByVal intHours As Integer, _
Optional ByVal intMinutes As Integer, _
Optional ByVal intSeconds As Integer) _
' Rounds datDate to hours and/or minutes and/or seconds as
' specified in parameters intHours, intMinutes, and intSeconds.
' Will accept any value within the range of data type Date:
' From 100-01-01 00:00:00 to 9999-12-31 23:59:59
' In case the range is exceeded due to rounding, the min. or max.
' value will be returned.
' DateRound(#9999-12-31 23:57:50#,0,5,0)
' returns: 9999-12-31 23:59:59
' DateRound(#9999-12-31 23:57:10#,0,5,0)
' returns: 9999-12-31 23:55:00
' DateRound(#9999-12-30 22:57:50#,0,5,0)
' returns: 9999-12-30 23:00:00
' DateRound(#2015-02-28 12:37:50#,0,15,0)
' returns: 2015-02-28 12:45:00
' DateRound(#2015-05-05 11:27:52#,3,0,0)
' returns: 2015-05-05 12:00:00
' DateRound(#2015-05-25 11:11:13#,0,0,2)
' returns: 2015-05-25 11:11:14
' Round to the tenth of a day:
' DateRound(#2012-11-15 15:00:00#, 2, 24, 0)
' returns: 2012-11-15 14:24:00
' 2008-04-16. Gustav Brock, Cactus Data ApS, CPH.
' 2010-05-12. Modified CDate expression.
Dim datRounding As Date
On Error GoTo Err_DateRound
datRounding = TimeSerial(intHours, intMinutes, intSeconds)
If datRounding <= 0 Then
' Round to the second.
datRounding = TimeSerial(0, 0, 1)
' Apply CDec to prevent rounding errors from Doubles and allow large values.
datDate = CDate(Int(CDec(datDate) / CDec(datRounding) + 0.5) * datRounding)
DateRound = datDate
If datDate < 0 Then
datDate = #1/1/100#
datDate = #12/31/9999 11:59:59 PM#
Open in new window
Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.
From novice to tech pro — start learning today.
Premium members can enroll in this course at no extra cost.