Calculating and Rounding Time to Nearest 15 min Interval

[SherylH]

After finally getting my spreadsheet to do exactly what I want it to do, the payroll department made a change...grrr.

Now the goal is to automatically round the time to the nearest 15 minute increment within the same cell. I also want to total these times at the end of the row to show hours and minutes instead of converted to decimals. I already have code to enter a time in one cell and it automatically insert the colon without having to type it. Another drawback, we have some shifts that work past midnight. This is overcome by entering the date and the time, and I don't have any problems with that...yet.

My current VBA:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vVal
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("B5:I329")) Is Nothing Then Exit Sub

With Target

vVal = Format(.Value, "0000")
If IsNumeric(vVal) And Len(vVal) = 4 Then
Application.EnableEvents = False
.Value = Left(vVal, 2) & ":" & Right(vVal, 2)
.NumberFormat = "[h]:mm"
End If
End With

Application.EnableEvents = True

End Sub

And the current formula for calculating the row of times:

=+((C5-B5+E5-D5+G5-F5+I5-H5)*1)*24

Example of what I would enter on the spreadsheet:

B5=0550 C5=1536 D5=1605 E5=1805 J5=11.77 (Total converted to decimal)

What I want each cell to look like:

B5=05:45 C5=15:30 D5=16:00 E5=18:00 J5=12.30

Sorry if this is confusing, but I have racked my brain for the past week. Let me know if you'd like to see the actual spreadsheet.

Thanks

 

[SherylH]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vVal
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Range("B5:I329")) Is Nothing Then Exit Sub
     
    With Target
         
        vVal = Format(.Value, "0000")
        If IsNumeric(vVal) And Len(vVal) = 4 Then
            Application.EnableEvents = False
            .Value = Left(vVal, 2) & ":" & Right(vVal, 2)
            .NumberFormat = "[h]:mm"
        End If
    End With
     
    Application.EnableEvents = True
     
End Sub

 

[SherylH]

Sorry, this was cross-posted. Didn't realize it was an issue until after I posted.

http://www.thecodecage.com/forumz/m...-time-nearest-15-min-interval.html#post625000

 

[SherylH]

Cross-posted http://www.excelforum.com/excel-200...rounding-time-to-nearest-15-min-interval.html

 

[mikerickson]

This will do the entry to nearest 15 minute part.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim vVal As String
    With Target
        If .Cells.Count = 1 And Not (Application.Intersect(.Cells, Range("B5:I329")) Is Nothing) Then
                Application.EnableEvents = False
                vVal = Format(.Value, "0000")
                If IsNumeric(vVal) And Len(vVal) = 4 Then
                    Application.EnableEvents = False
                    .Value = Left(vVal, 2) & ":" & Right(vVal, 2)
                    .NumberFormat = "[h]:mm"
                End If
                
                If IsNumeric(.Value) Then
                   .Value = CDate(Application.Round(Val(.Value) * 24 * 4, 0) / 24 / 4)
                    Application.EnableEvents = True
                End If
        End If
    End With
    Application.EnableEvents = True
End Sub

The formula should work to sum the times.

 

[SherylH]

This will do the entry to nearest 15 minute part.

The formula should work to sum the times.

This didn't work. Also, the formula is to convert to decimal and I need it back to hours and minutes.

Thanks for your help

 

[mikerickson]

What are the details of it not working. What entry did you make that wasn't converted properly, what did you want it to convert things to.


If you want the formula to return a sum of times in Excel serial time, = MOD(1+C5-B5,1)+MOD(1+E5-D5,1)+MOD(1+G5-F5,1)+MOD(1+I5-H5,1) will do that. This formulation will handle the midnight situation, but does not require (but will accept) both the date and time being entered. The h:mm formatting can be added with cell formatting.

 

[SherylH]

I guess something was going on yesterday, I re-pasted today and the conversion works...and the new formula works too. And I don't have to put in dates anymore. You have been a lifesaver, well at least a timesaver.

Thanks again