Please help with Time Rounding

S

slharman1

Member
Local time
Today, 03:23
Joined
Mar 8, 2021
Messages
483
I have copied the following code from another thread, post #4, the thread is located here:

roundup or down to the nearest half is it possible?

Hi I'm wandering if it's possible to get access to round numbers to the nearest 1/2 hour i.e. 0.5, 1.5 or 2.0 depending on the result. Any help much appreciated. Oh by the way I'm using 2003.
www.access-programmers.co.uk

It is not working , please help
Code: 
Public Function RoundTime(varTime As Variant, Optional ByVal lngSeconds As Long = 900&) As Variant

'The function below rounds a date/time value to the specified number of seconds. For example, to round to the nearest half hour (30 * 60 seconds), use:
'    =RoundTime([MyDateTimeField], 1800)

    'Purpose:   Round a date/time value to the nearest number of seconds
    'Arguments: varTime = the date/time value
    '           lngSeconds = number of seconds to round to.
    '               e.g.  60 for nearest minute,
    '                    600 for nearest 10 minutes,
    '                   3600 for nearest hour,
    '                  86400 for nearest day.
    'Return:    Rounded date/time value, or Null if no date/time passed in.
    'Note:      lngSeconds must be between 1 and 86400.
    '           Default rounds is nearest 15 minutes.
    Dim lngSecondsOffset As Long
    
    RoundTime = Null        'Initialize to return Null.
    If Not IsError(varTime) Then
        If IsDate(varTime) Then
            If (lngSeconds < 1&) Or (lngSeconds > 86400) Then
                lngSeconds = 1&
            End If
            lngSecondsOffset = lngSeconds * CLng(DateDiff("s", #12:00:00 AM#, TimeValue(varTime)) / lngSeconds)
            RoundTime = DateAdd("s", lngSecondsOffset, DateValue(varTime))
        End If
    End If
End Function
 
It works for me except for the seconds. The seconds only round down.
Code: 
Public Sub roundit()
  Dim timeval As Date
  timeval = #12:00:59 PM#
  Debug.Print RoundTime(timeval, 600) & " Time:" & timeval
End Sub
I would expect 12:01:00 here is the result
12:00:00 PM Time:12:00:59 PM
 
Ok so what I did was put the code in the query field for the recordsource and it works, but I can't seem to format the new date field.
How would I go about this?
 
Last edited:
Ok, Sorry, I was brain dead, I've got the function working does anyone know how to make it round only up or only down?
 
Here's a simpler function to round DateTime values to a particular increment...
Code: 
Function RoundDateToNearest(d1 As Date, RoundTo As Date) As Date
    RoundDateToNearest = CLng(d1 / CDbl(RoundTo)) * RoundTo
End Function
Here's some test code...
Code: 
Private Sub Test1892734981234()
    Dim t1 As Date
    
    Debug.Print "Saturday", RoundDateToNearest(Date, 7)
    
    t1 = TimeSerial(6, 0, 0)
    Debug.Print "6 hrs", RoundDateToNearest(Now(), t1)
    t1 = TimeSerial(2, 0, 0)
    Debug.Print "2 hrs", RoundDateToNearest(Now(), t1)
    t1 = TimeSerial(1, 30, 0)
    Debug.Print "1.5 hrs", RoundDateToNearest(Time, t1)
    
    t1 = TimeSerial(0, 15, 0)
    Debug.Print "15 mins", RoundDateToNearest(#12:07:29 PM#, t1)
    Debug.Print "15 mins", RoundDateToNearest(#12:07:30 PM#, t1)
    Debug.Print "15 mins", RoundDateToNearest(#12:07:31 PM#, t1)
    
    t1 = TimeSerial(0, 0, 15)
    Debug.Print "15 secs", RoundDateToNearest(Time, t1)
    t1 = TimeSerial(0, 0, 5)
    Debug.Print "5 secs", RoundDateToNearest(Time, t1)
    Debug.Print "Now", Now()
    Debug.Print
    
End Sub
 
To round up, add half your RoundTo to d1, like...
Code: 
Function RoundUpToNearestDate(d1 As Date, Optional RoundTo As Date = 1) As Date
      RoundUpToNearestDate = CLng((d1 + RoundTo / 2) / RoundTo) * RoundTo
End Function
 
MarkK said:
Here's a simpler function to round DateTime values to a particular increment...
Code: 
Function RoundDateToNearest(d1 As Date, RoundTo As Date) As Date
    RoundDateToNearest = CLng(d1 / CDbl(RoundTo)) * RoundTo
End Function
Here's some test code...
Code: 
Private Sub Test1892734981234()
    Dim t1 As Date
   
    Debug.Print "Saturday", RoundDateToNearest(Date, 7)
   
    t1 = TimeSerial(6, 0, 0)
    Debug.Print "6 hrs", RoundDateToNearest(Now(), t1)
    t1 = TimeSerial(2, 0, 0)
    Debug.Print "2 hrs", RoundDateToNearest(Now(), t1)
    t1 = TimeSerial(1, 30, 0)
    Debug.Print "1.5 hrs", RoundDateToNearest(Time, t1)
   
    t1 = TimeSerial(0, 15, 0)
    Debug.Print "15 mins", RoundDateToNearest(#12:07:29 PM#, t1)
    Debug.Print "15 mins", RoundDateToNearest(#12:07:30 PM#, t1)
    Debug.Print "15 mins", RoundDateToNearest(#12:07:31 PM#, t1)
   
    t1 = TimeSerial(0, 0, 15)
    Debug.Print "15 secs", RoundDateToNearest(Time, t1)
    t1 = TimeSerial(0, 0, 5)
    Debug.Print "5 secs", RoundDateToNearest(Time, t1)
    Debug.Print "Now", Now()
    Debug.Print
   
End Sub
Click to expand...
Thanks, I am going to do some testing, how does this handle a date like 1/6/2021 11:59 with rounding up to the nearest 15 minutes?
Will it give me 1/7/2021 12:00?
Will it
 
MarkK said:
To round up, add half your RoundTo to d1, like...
Code: 
Function RoundUpToNearestDate(d1 As Date, Optional RoundTo As Date = 1) As Date
      RoundUpToNearestDate = CLng((d1 + RoundTo / 2) / RoundTo) * RoundTo
End Function
Click to expand...
RoundUpToNearestDate not working, I used the same arguments when test the first function.
Am I doing something wrong?

Getting Runtime error '6'
Overflow

Here's my code:
Code: 
Private Sub Form_Current()

    If IsNull(txtAdjTimeIn) Then
        Dim T1 As Date
        T1 = TimeSerial(0, 15, 0)
        txtAdjTimeIn = RoundUpToNearestDate(txtTimeIn, T1)
    End If
   
End Sub
 
I can't get it to fail. What line causes the error?
 
slharman1 said:
RoundUpToNearestDate not working, I used the same arguments when test the first function.
Am I doing something wrong?

Getting Runtime error '6'
Overflow

Here's my code:
Code: 
Private Sub Form_Current()

    If IsNull(txtAdjTimeIn) Then
        Dim T1 As Date
        T1 = TimeSerial(0, 15, 0)
        txtAdjTimeIn = RoundUpToNearestDate(txtTimeIn, T1)
    End If
  
End Sub
Click to expand...
Showing your arguments would help?
 
Gasman said:
Showing your arguments would help?
Click to expand...
I copied and pasted then realized the code wasn’t complete. Works perfect. Now I have to figure out how to get rid of the seconds in my data so they 5:30 doesn’t become 5:45. Any ideas?
My form that enters the original data captures the date and time, then the form that takes that value and rounds it does what my question above in this post says. Need to get rid of the seconds in the first field. I am thinking I need a format statement in my code - sound right?
Thanks
 
slharman1 said:
Now I have to figure out how to get rid of the seconds in my data so they 5:30 doesn’t become 5:45. Any ideas?
Click to expand...
Isn't this why you are rounding the time? Why get rid of the seconds, and then round.
 
MarkK said:
Isn't this why you are rounding the time? Why get rid of the seconds, and then round.
Click to expand...
This is for calculating payroll times and if I don't strip the seconds when using your rounding up function - 5:30:01 becomes 5:45:00
But your functions still Rounds 5:30 up to 5:45 - am i doing something wrong?


Code: 
Public Function RoundUpToNearestDate(d1 As Date, Optional RoundTo As Date = 1) As Date
      'not working
      RoundUpToNearestDate = CLng((d1 + RoundTo / 2) / CDbl(RoundTo)) * RoundTo
End Function

Code: 
Private Sub Form_Current()
    
    If IsNull(txtAdjTimeIn) And Not IsNull(txtTimeIn) Then
        
        Dim t1 As Date
        Dim t2 As Date
        t2 = DateValue([txtTimeIn]) + TimeSerial(Hour([txtTimeIn]), Minute([txtTimeIn]), 0)
        
        t1 = TimeSerial(0, 15, 0)
        [txtAdjTimeIn] = RoundUpToNearestDate(t2, t1)
        
        'txtAdjTimeIm = roundDate(txtTimeIn, 3)
    End If
    
        If IsNull(txtAdjTimeOut) And Not IsNull(txtTimeOut) Then
        
        Dim t3 As Date
        Dim t4 As Date
        t4 = DateValue([txtTimeOut]) + TimeSerial(Hour([txtTimeOut]), Minute([txtTimeOut]), 0)
        
        t3 = TimeSerial(0, 15, 0)
        [txtAdjTimeOut] = RoundDnToNearestDate(t4, t3)
        
        'txtAdjTimeIm = roundDate(txtTimeIn, 3)
    End If

    
End Sub


I have also created a RoundDnToNearest function to round the time down. So far It seems to work.
 
I found another solution to my rounding problem.
Code: 
TimeSerial(Hour([mytime]),(Minute([mytime])\15)*15,0)
Can anyone tell me how to change this to round up?
 
slharman1 said:
This is for calculating payroll times and if I don't strip the seconds when using your rounding up function - 5:30:01 becomes 5:45:00
Click to expand...

As afar as I can see the problem is in your description. You wanted it rounded up
5:30:01 rounded UP to the nearest next 15 minutes is 5:45

I don't think your description matches your actual output requirement. What about 5:31:03 ? or 5:30:59
 
I used to use increments of 6 minutes?, one tenth of an hour?
 
Minty said:
As afar as I can see the problem is in your description. You wanted it rounded up
5:30:01 rounded UP to the nearest next 15 minutes is 5:45

I don't think your description matches your actual output requirement. What about 5:31:03 ? or 5:30:59
Click to expand...
The problem is this:
I do not want to round up if the employee punches in at 5:30:01, that is still considered punching in at 5:30, it is only when they punch in at 5:31:00 or greater that I want to round up.
 
Gasman said:
I used to use increments of 6 minutes?, one tenth of an hour?
Click to expand...
I am not sure what you are saying here Gasman, If my employee is late by 1 minute then they are considered late.
so...
5:30:01 still needs to round to 5:30 but 5:31:00 needs to round up to 5:45:00

The similar situation applies when they are punching out.
 
You must log in or register to reply here.

Similar threads

N
Solved Big variation when sending data through Cloud SQL Server Vs MS Access
Replies
10
Views
669
Pat Hartman
P
MattBaldry
Activity Timing
2
Replies
22
Views
700
MattBaldry
MattBaldry
K
Round to the nearest quarter (15 minutes)
Replies
8
Views
785
arnelgp
arnelgp
G
Code compilation problem
Replies
9
Views
791
George-Bowyer
G
C
Format datetime like mm/dd/yyyy hh:mm if time value, else mm/dd/yyyy
Replies
18
Views
1,643
Minty
Minty

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom