Access function to round time to quarter hour

[bdmoran]

Hello,

I have a report in access that has a list of times employees clocked out of their shift. I need to round the time they clocked out to the nearest quarter hour but expressed as a decimal.

for example, I need anything less than <=3:59=4.00 anything >=4:15=4.25 etc.

Any help would be appreciated!

 

[MajP]

need to see how you calcualte Actual? Need to know the data types of the fields used in the calculation. Need to see how you use the code.

 

[bdmoran]

Ok so I used a query to calculate ACTUAL. It is as follows:

ACTUAL: [In Time]- [Out time]

Actual, In time and out time are all formatted in short time.

For the code, I created a new module in Access then copy and pasted the code you sent me. Now that the function is saved as a Module I went ahead to my report, used the expression builder and entered:

Roundtime([Actual]) which is when I recieved all .25 for my results.

 

[MajP]

If you can calculate actual in your query you could easily calculate the rounded time using the first function (two parameter)
SELECT
[OutTime]-[inTime] AS Actual,
RoundTime([InTime],[OutTime]) AS RoundedActual
FROM Table1;


Based on the way you calculate elapsed time, you may need to use this function instead. Because that calculation would convert
in time 11:00:00 am
out time 4:00:00 Pm
Actual: 0.208333333333333

Although that is formatted to be 5:00 it is calculated field so .20833 is passed instead and it does not try to force 5:00 into a datetime.

Public Function roundTime3(elapsedTime As Variant) As String
  On Error Resume Next
    Dim tempTime As Date
    elapsedTime = CDate(elapsedTime)
    tempTime = elapsedTime - Int(elapsedTime)
    If Abs(Fix(tempTime * 96) / 96 - (tempTime * 96) / 96) < 0.0001 Then
      tempTime = Fix(tempTime * 96) / 96 - (15 / (24 * 60))
    Else
      tempTime = Fix(tempTime * 96) / 96
    End If
    roundTime3 = Format(tempTime, "hh.mm")
    roundTime3 = Replace(roundTime3, ".15", ".25")
    roundTime3 = Replace(roundTime3, ".30", ".50")
    roundTime3 = Replace(roundTime3, ".45", ".75")
End Function

 

[bdmoran]

Hello - This formula worked out perfectly! Thanks for your help.

However, when I met with the finance department I realized some of the numbers didn't round up accordingly. My co-worker sent me a list of numbers and how she would like them rounded up.

Is there any way you can alter the formula to reflect these numbers?

:01-:15=.25
:16-:30=.50
:31-:45=.75
:46-:00=00

 

[MajP]

Public Function roundTime(elapsedTime As Variant) As String
  On Error Resume Next
    Dim tempTime As Date
    elapsedTime = CDate(elapsedTime)
    tempTime = elapsedTime - Int(elapsedTime)
    If Abs(Fix(tempTime * 96) / 96 - (tempTime * 96) / 96) < 0.0001 Then
      tempTime = Fix(tempTime * 96) / 96
    Else
      tempTime = Fix(tempTime * 96) / 96 + (15 / (24 * 60))
    End If
    roundTime = Format(tempTime, "hh.mm")
    roundTime = Replace(roundTime, ".15", ".25")
    roundTime = Replace(roundTime, ".30", ".50")
    roundTime = Replace(roundTime, ".45", ".75")
End Function

 

[bdmoran]

Hey I am getting the #Error message and I'm not sure why. The function before this worked perfectly.

 

[dhookom]

Are any of the fields Null? This would generate an error at:

   elapsedTime = CDate(elapsedTime)

Duane
Hook'D on Access
MS Access MVP

 

[bdmoran]

No Nulls. Maybe something happened when I copy and pasted it into access as a Module? The initial function worked fine there was just a rounding issue.

 

[MajP]

Technically Duane is correct, it would throw an error. However that cannot be the problem becase the original function traps the error and would return the value 00:00 because of the resume next. You could even pass in a string and it would return the correct value if the string can be converted to a date.

If you pass in null this line would error
elapsedTime = CDate(elapsedTime)
The code would return at the next line
tempTime = elapsedTime - Int(elapsedTime)
It would error again and return here
If Abs(Fix(tempTime * 96) / 96 - (tempTime * 96) / 96) < 0.0001 Then
tempTime = Fix(tempTime * 96) / 96
Else
Since tempTime has never been set to a value it takes it default of 0 and the code completes returning 0:00

The only thing I think could cause your problem is you are not calling the function correctly.

You can use this if you rather see an empty cell for null values and an error for improperly formatted strings

Public Function roundTime(elapsedTime As Variant) As String
  On Error GoTo errLbl
    Dim tempTime As Date
    elapsedTime = CDate(elapsedTime)
    tempTime = elapsedTime - Int(elapsedTime)
    If Abs(Fix(tempTime * 96) / 96 - (tempTime * 96) / 96) < 0.0001 Then
      tempTime = Fix(tempTime * 96) / 96
    Else
      tempTime = Fix(tempTime * 96) / 96 + (15 / (24 * 60))
    End If
    roundTime = Format(tempTime, "hh.mm")
    roundTime = Replace(roundTime, ".15", ".25")
    roundTime = Replace(roundTime, ".30", ".50")
    roundTime = Replace(roundTime, ".45", ".75")
    Exit Function
errLbl:
    If Not Err.Number = 94 Then
       If Err.Number = 13 Then
         roundTime = "Inputs are not date or null"
       Else
         roundTime = Err.Number & ": " & Err.Description
       End If
    End If
End Function