TimeRound

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

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 525 Downloads 146

'Roundup', 'RoundDown', 'floor', 'ceiling'

ANmarAmdeen
324
Date+Time Classic ASP
Revisions

v1.0