Home How to calculate the time extends with rest time

# How to calculate the time extends with rest time

Vito
1#
Vito Published in 2018-01-13 02:04:56Z
 Given that a start time and end time . Like 8:30- 10:30 , so I can calculate the duration (minutes) -->120 the situation : every 45 min , a short 5 mins break will be given . It will be 8:30-9:15 (first session) (45min accumulate ) ,9:15-9:20(1 rest time) ,9:20-10:05(2 session)(90 min accumulate ) ,10:05-10:10 (2 rest time) .10:10-10:40 (3 session ) (reminding time 30 min =120-90) , no third rest i just want to output : 8:30 -10:40(start to end) & every rest time(start and end ) : 9:15 to 9:20 , 10:10-10:40 Any excel or VBA solutions to perform this ? the sample input can be : 830-12:34 ,930-1732 , 9:30-23:67 My current working :(total minute as 158) 8:30-11:08 first calculate the duration in minute Input :830 , 11:08 output : red line in picture : new end time , every rest time start ,every rest time end
Variatus
2#
 OK. The code below calculates every time in the process. To test it, take a blank worksheet, enter a start time in B2 and an end time in C2, then run the code. Install the code in a standard code module. A standard code module will have the default name of Module1. It is none of the modules available in a new workbook. You will have to add it. (Right-click on the VBA project in the Project Explorer window on the left of your VBE screen and select Insert and Module.) Option Explicit Enum Nws ' worksheet navigation ' 15 Jan 2018 NwsFirstResultRow = 4 NwsCaption = 1 ' 1 = column A NwsStart ' each period's start time NwsEnd ' 3 = C End Enum Sub CalculateRestTimes() ' 15 Jan 2018 Const StartTime As String = "B2" ' change as required Const EndTime As String = "C2" ' change as required Const BreakTime As Long = 5 Const WorkPeriod As Long = 45 Dim Tstart As Double, Tend As Double Dim Twork As Double, Tbreak As Double Dim Rng As Range Dim R As Long Dim p As Integer Twork = Round(WorkPeriod / 1440, 6) Tbreak = Round(BreakTime / 1440, 6) Application.ScreenUpdating = False With Worksheets("RestTimes") ' change as required Tstart = Round(Val(.Range(StartTime).Value2), 6) Tend = Round(Val(.Range(EndTime).Value2), 6) If Tstart = 0 Or Tend = 0 Then MsgBox "Start or end time is not entered correctly.", _ vbCritical, "Invalid or missing entry" End If R = Application.Max(.Cells(.Rows.Count, NwsCaption).End(xlUp).Row, NwsFirstResultRow) Set Rng = Range(.Cells(NwsFirstResultRow, NwsCaption), .Cells(R, NwsEnd)) Rng.ClearContents R = NwsFirstResultRow - 1 Do While Tstart < Tend R = R + 1 p = p + 1 .Cells(R, NwsCaption).Value = Ordinal(p) & " period" .Cells(R, NwsStart).Value2 = Tstart Tstart = Application.Min((Tstart + Twork), Tend) .Cells(R, NwsEnd).Value2 = Tstart If (Tstart + (20 / 1440)) <= Tend Then R = R + 1 .Cells(R, NwsCaption).Value = Ordinal(p) & " rest" .Cells(R, NwsStart).Value2 = Tstart Tend = Tend + Tbreak Tstart = Tstart + Tbreak .Cells(R, NwsEnd).Value2 = Tstart Else .Cells(R, NwsEnd).Value2 = Tend Exit Do End If Loop Set Rng = Range(.Cells(NwsFirstResultRow, NwsStart), .Cells(R, NwsEnd)) Rng.NumberFormat = "HH:mm" End With Application.ScreenUpdating = True End Sub Private Function Ordinal(ByVal n As Integer) As String ' 13 Jan 2018 Dim Suff As Variant Dim i As Integer Suff = Array("th", "st", "nd", "rd") i = n Mod 10 Ordinal = CStr(n) & Suff(IIf(i > 3, 0, i)) End Function 
 Please try this formula, where the start time is in B2 and the end time is in C2. The formula will return a new end time extended by 5 minutes for every 45 minut4es of original work time. =$C2+(INT(($C2+IF($B2>$C2,1,0)-\$B2)*1440/45)*5/1440)  I think the formula should return a wrong result if there are 9 or more breaks within the net work time. If this is really so and if that is an issue it can be adjusted.
 The following user-defined functions will be calculated excluding breaks. Function getTime(s, e) Dim wf As WorksheetFunction Dim myTime As Date, t As Date Dim i As Integer, n As Integer Dim Other() Set wf = WorksheetFunction If s > e Then myTime = e - s + 1 s = 0 Else myTime = e - s End If t = s + TimeSerial(0, 45, 0) Do n = n + 2 ReDim Preserve Other(1 To n) Other(n - 1) = t Other(n) = t + TimeSerial(0, 5, 0) t = t + TimeSerial(0, 50, 0) Loop While e > t With wf For i = LBound(Other) To UBound(Other) Step 2 If Other(i + 1) > e Then Exit For myTime = myTime - (.Min(e, Other(i + 1)) - .Max(s, Other(i))) Next i End With getTime = myTime * 1440 End Function  Break time will come to the table. Sub test() Dim s, e s = Range("b9") e = Range("B27") getTimetable s, e, Range("b10") End Sub Sub getTimetable(s, e, target As Range) Dim wf As WorksheetFunction Dim myTime As Date, t As Date Dim i As Integer, n As Integer Dim Other() Set wf = WorksheetFunction If s > e Then myTime = e - s + 1 s = 0 Else myTime = e - s End If t = s + TimeSerial(0, 45, 0) Do n = n + 2 ReDim Preserve Other(1 To n) Other(n - 1) = t Other(n) = t + TimeSerial(0, 5, 0) t = t + TimeSerial(0, 50, 0) Loop While e > t With wf For i = LBound(Other) To UBound(Other) Step 2 If Other(i + 1) > e Then Exit For myTime = myTime - (.Min(e, Other(i + 1)) - .Max(s, Other(i))) Next i End With If n Then target.Resize(n) = WorksheetFunction.Transpose(Other) End If End Sub