Rounding time

[RachDobs]

Hi all,
Do any of you clever people out there know how to get me out of little
problem??

What I want is a function that rounds time, either up or down, to the
nearest value.

What I am thinking is something along these lines:

Function RoundTime(Time as Date, RoundTo as Integer, RoundUp as
Boolean)

'Time - Inputted Time
'RoundTo - Round to nearest
'RoundUp - Round up if true else round down


End Function

What I want to be able to enter is a time and then for instance 15 so
that the entered time is rounded to the nearest 15 mins depending on
whether it needs to be rounded up or down.

Thanks for any help in advance

Rach

 

[Bob Phillips]

Rach,

Give this a whirl

Function RoundTime(Time As Date, RoundTo As Integer, RoundUp As Boolean)
Dim nDivisor As Double

nDivisor = 60 / RoundTo
If RoundUp Then
RoundTime = WorksheetFunction.RoundUp(Time * 24 * nDivisor, 0) /
nDivisor / 24
Else
RoundTime = WorksheetFunction.RoundDown(Time * 24 * nDivisor, 0) /
nDivisor / 24
End If

End Function

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Michael J. Malinsky]

Try this...it seems to work with VERY minimal testing:

Function RoundTime(Time As Date, RoundTo As Integer, RoundUp As Boolean)

Dim RoundMin As Integer 'Holds the rounded minute
Dim CurrentMin As Integer 'Holds the minute value for the time input
Dim DiffMin As Integer 'Holds the difference between RoundMin and
CurrentMin

CurrentMin = Minute(Time) 'Grab the minute value for the time value
entered.

If RoundUp = False Then 'Round the minute to nearest multiple
RoundMin = Round(CurrentMin / RoundTo, 0) * RoundTo
Else 'Round the minute up to nearest multiple
RoundMin = Int((CurrentMin + RoundTo - 1) / RoundTo) * RoundTo
End If

DiffMin = RoundMin - CurrentMin 'Calculate the difference in the rounded
'minute value and the entered minute
value.

'In order to convert the difference from actual minutes to what Excel
'calculates as a minute, we need to multiply DiffMin by 0.00069444.
RoundTime = Time + (DiffMin * 6.94444444444442E-04)

End Function

HTH
Mike

 

[JE McGimpsey]

Just another way:

Public Function RoundTime(dTime As Double, nMin As Integer, _
Optional bRoundUp As Boolean = True) As Double
If bRoundUp Then
RoundTime = Application.Ceiling(dTime, TimeSerial(0, nMin, 0))
Else
RoundTime = Application.Floor(dTime, TimeSerial(0, nMin, 0))
End If
End Function

 

[RachDobs]

Thanks all, will give them all a try.

Rac