Home How to calculate the time extends with rest time
Reply: 3

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#
Variatus Reply to 2018-01-15 04:04:23Z

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
Variatus
3#
Variatus Reply to 2018-01-13 03:19:36Z

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.

Dy.Lee
4#
Dy.Lee Reply to 2018-01-13 04:14:57Z

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

You need to login account before you can post.

About| Privacy statement| Terms of Service| Advertising| Contact us| Help| Sitemap|
Processed in 0.373471 second(s) , Gzip On .

© 2016 Powered by mzan.com design MATCHINFO