TimeRound

Rounds the number of minutes to the nearest quarter of half
like 4:32 to 4:30 or 4:45

CodeFunctionName
What is this?

Public

Tested

Original Work
Function TimeRound(ttTime, RoundStyle)
' Shift Min up or down to nearest 15 or 30 minutes
' Call can control all settings
' TimeFormat : the time in time format
' RoundStyle : then identifier of how to round
' 1 : shift the minutes up to quarters
' 2 : shift the minutes down to quarters
' 3 : shift the minutes to quarters up or down depend upon the minutes no
' 4 : shift the minutes up to halves
' 5 : shift the minutes down to halvesf
' 6 : shift the minutes to halves up or down depend upon the minutes no
HoursNo = Hours(ttTime)
MinutesNo = Minutes(ttTime)
Select Case RoundStyle
Case 1 ' Quarters up
If MinutesNo - 15 < 0 Then MinutesNo = 15
If MinutesNo > 15 And MinutesNo < 30 Then MinutesNo = 30
If MinutesNo > 30 And MinutesNo < 45 Then MiuntesNo = 45
If MinutesNo > 45 Then MinutesNo = 0: HoursNo = HoursNo + 1
Case 2 ' Quarters down
If MinutesNo - 15 < 0 Then MinutesNo = 0
If MinutesNo >= 15 And MinutesNo < 30 Then MinutesNo = 15
If MinutesNo >= 30 And MinutesNo < 45 Then MinutesNo = 30
If MinutesNo >= 45 Then MinutesNo = 45
Case 3 ' Quarters auto
If MinutesNo < 8 Then
MinutesNo = 0
ElseIf (MinutesNo >= 8 And MinutesNo <= 15) Or (MinutesNo > 15 And MinutesNo < 23) Then
MinutesNo = 15
ElseIf (MinutesNo >= 23 And MinutesNo <= 30) Or (MinutesNo > 30 And MinutesNo < 38) Then
MinutesNo = 30
ElseIf (MinutesNo >= 38 And MinutesNo <= 45) Or (MinutesNo > 45 And MinutesNo < 53) Then
MinutesNo = 45
ElseIf MinutesNo >= 53 Then
MinutesNo = 0
HoursNo = HoursNo + 1
End If
Case 4 ' halves up
If MinutesNo > 0 And MinutesNo < 30 Then
MinutesNo = 30
ElseIf MinutesNo > 30 And MinutesNo <= 59 Then
MinutesNo = 0
HoursNo = HoursNo + 1
End If
Case 5 ' halves down
If MinutesNo < 30 Then
MinutesNo = 0
ElseIf MinutesNo > 30 And MinutesNo <= 59 Then
MinutesNo = 30
End If
Case 6 ' halves auto
If MinutesNo <= 15 Then
MinutesNo = 0
ElseIf MinutesNo > 15 And MinutesNo < 30 Then
MinutesNo = 30
ElseIf MinutesNo > 30 And MinutesNo <= 45 Then
MinutesNo = 30
ElseIf MinutesNo > 45 Then
MinutesNo = 0
HoursNo = HoursNo + 1
End If
End Select
TimeRound = TimeSerial(HoursNo, MinutesNo, 0)
End Function

ttTime, RoundStyle

Views 4,372

Downloads 1,342

CodeID
DB ID