Calling a sub for different start and end times - excel

Question

#Variatus Ref the macro you have been working on, for a Friday production the shift will still start at 05:30 but end at 18:30 and if Saturday production the shift will start at 07:00 and finish at 14:00. am I correct in thinking I need to add another Enum called Day 5 Nsh with the start and end time and then same again for day 6 calling it Day 6 Nsh. If this is correct then in the sub Setcompletion how would I call this. would it need to be referenced any where else in the macro also?
Enum Nws ' Worksheet navigation
NwsFirstDataRow = 2
NwsQty = 1 ' Columns (not necessarily contiguous):
NwsTime ' time to produce one unit
NwsStart ' date/time
NwsEnd ' date/time
End Enum
Enum Nsh ' Shift (use 24h format)
NshStart = 530 ' read as 05:30 (on current day)
NshEnd = 2430 ' read as 00:30 (on next day)
End Enum
next
Sub SetCompletion(ws As Worksheet, R As Long)
' 25 Mar 2017
Dim Qty As Long
Dim ShiftQty As Long, DayQty As Long
Dim UnitTime As Double, StartTime As Double
Dim ComplDate As Double
Dim Days As Integer
With Rows(R)
Qty = .Cells(NwsQty).Value
UnitTime = .Cells(NwsTime).Value
StartTime = .Cells(NwsStart).Value
If Qty And (UnitTime > 0) And (StartTime > 0) Then
ComplDate = (UnitTime * Qty) + StartTime
ShiftQty = QtyTillShiftEnd(StartTime, UnitTime)
If ShiftQty < Qty Then
Qty = Qty - ShiftQty
DayQty = DailyProduction(UnitTime)
ComplDate = Int(StartTime) + 1 + NshToDays(NshStart) + Int(Qty / DayQty)
ComplDate = ComplDate + UnitTime * (Qty Mod DayQty)
End If
.Cells(NwsEnd).Value = ComplDate
End If
End With
End Sub
next
Private Function QtyTillShiftEnd(ByVal StartTime As Double, _
ByVal UnitTime As Double) As Double
' 20 Mar 2017
Dim ProdTime As Double
ProdTime = (Int(StartTime) + NshToDays(NshEnd) - StartTime)
QtyTillShiftEnd = (ProdTime + 0.0001) / UnitTime
End Function
next
Private Function DailyProduction(UnitTime As Double) As Integer
' 19 Mar 2017
DailyProduction = Int((NshToDays(NshEnd) - NshToDays(NshStart) + 0.000001) / UnitTime)
End Function
next
Private Function NshToDays(TimeCode As Nsh) As Double
' 19 Mar 2017
Dim H As Double, M As Double
H = Int(TimeCode / 100)
M = TimeCode Mod 100
NshToDays = (1 / 24 * H) + (1 / 24 / 60 * M)
End Function
next
Function AdjustedStartTime(ByVal StartTime As Double) As Double
' 19 Mar 2017
' return new StartTime or 0
Dim Fun As Double
Dim StartDate As Long
Dim ShiftStart As Double, ShiftEnd As Double
ShiftStart = NshToDays(NshStart)
ShiftEnd = NshToDays(NshEnd)
StartDate = Int(StartTime)
StartTime = StartTime - StartDate
Fun = StartTime
If ShiftEnd > 1 Then
If StartTime < (ShiftStart - Int(ShiftStart)) Then
If StartTime > (ShiftEnd - Int(ShiftEnd)) Then Fun = ShiftStart
End If
Else
If (StartTime - Int(StartTime)) < ShiftStart Then
Fun = ShiftStart
Else
If StartTime > ShiftEnd Then Fun = ShiftStart + 1
End If
End If
AdjustedStartTime = Fun + StartDate
End Function

Answer 1

Plese set up a named range in your workbook and call it "SpecialDays". I suggest you create a dedicated worksheet to house it and make it accessible throughout the workbook. The picture below illustrates and explains.
The program's logic will be like this:-
There will be no production on any day marked as Holiday
There will be a short shift on any day marked as "Half shift"
There will be a full shift on any day marked as "full shift"
There will be no work on weekends unless the days are marked as Special Days
There will be a full shift on all other days
The important part of this list is in the sequence: whichever condition applies first is the condition that prevails. For example, there will be a full shift on Sunday Dec 31 because the condition for "full shift" is met before that of the day being a Sunday, but if it were also listed as a holiday (in a second row, anywhere in the list) there would be no work because holidays are filtered out first.
In order to connect the range to your code, please add these three lines above the enums on your code sheet.
' a named range of this name must exist:
' it must have 2 columns, first with a date, 2nd with a number as Nsh
Const SpecialDays As String = "SpecialDays"
You can change the name of the range here, but must make sure that you use the same name here and on the worksheet where you name the range.
Now, as you already suggested, the Enum Nsh needs to be extended. Here it is. Just replace the existing with the new, in its entirety (meaning form the declaration to "End Enum".
Enum Nsh ' Shift
' 28 Mar 2017
NshFullShift = 0
NshHalfShift
NshNoShift
NshStart = 530 ' read as 05:30 (on current day)
NshEnd = 2430 ' read as 00:30 (on next day)
NshHalfStart = 700 ' (use 24h format)
NshHalfEnd = 1400
End Enum
The first three enumeration correspond to the numbers you may enter in the "SpecialDays" range's 2nd column.
Of course, the SetCompletion procedure must be modified. It now calculates each day's production individually instead of presuming that every day's output is the same.
Sub SetCompletion(Ws As Worksheet, R As Long)
' 28 Mar 2017
Dim Qty As Long, ShiftQty As Long
Dim CommenceTime As Double, UnitTime As Double
Dim ComplTime As Double
With Rows(R)
Qty = .Cells(NwsQty).Value
UnitTime = .Cells(NwsTime).Value
CommenceTime = .Cells(NwsStart).Value
If Qty And (UnitTime > 0) And (CommenceTime > 0) Then
ComplTime = CommenceTime + (UnitTime * Qty)
Qty = Qty - QtyTillShiftEnd(CommenceTime, UnitTime)
If Qty > 0 Then
Do While Qty > 0
ComplTime = Int(ComplTime) + 1
ShiftQty = DailyProduction(ComplTime, UnitTime)
If Qty > ShiftQty Then
Qty = Qty - ShiftQty
Else
ComplTime = ComplTime + StartTime(ShiftType(ComplTime)) + (Qty * UnitTime)
Exit Do
End If
Loop
End If
.Cells(NwsEnd).Value = ComplTime
End If
End With
End Sub
The daily production is different on different days. The new function therefore receives the date as an argument and calculates the production according to what kind of day it is: Holiday, half-shift or full-shift day. Of course, the same holds true for the calculation on the first day of production which starts at the CommenceTime, not the start of the shift.
Private Function QtyTillShiftEnd(ByVal CommenceTime As Double, _
ByVal UnitTime As Double) As Double
' 28 Mar 2017
Dim ProdTime As Double
Dim ShType As Nsh
ShType = ShiftType(CommenceTime)
ProdTime = Int(CommenceTime) + EndTime(ShType) - CommenceTime
QtyTillShiftEnd = Int((ProdTime + 0.0001) / UnitTime)
End Function
Private Function DailyProduction(ShiftDay As Double, _
UnitTime As Double) As Integer
' 28 Mar 2017
Dim ShType As Nsh
ShType = ShiftType(ShiftDay)
DailyProduction = Int((EndTime(ShType) - StartTime(ShType) + 0.0001) / UnitTime)
End Function
The NshToDays function remains unchanged in principle, but I modified the method by which the parameter is received (ByVal instead of the previous default ByRef).
Private Function NshToDays(ByVal TimeCode As Nsh) As Double
' 28 Mar 2017
Dim H As Double, M As Double
H = Int(TimeCode / 100)
M = TimeCode Mod 100
NshToDays = (1 / 24 * H) + (1 / 24 / 60 * M)
End Function
The next function has undergone a complete overhaul. It will now find the start of the next shift even if the entered start time is several days from where it should be.
Function AdjustedStartTime(ByVal CommenceTime As Double) As Double
' 28 Mar 2017
' return new CommenceTime or 0
Dim StartDate As Long
Dim ShType As Nsh
StartDate = Int(CommenceTime)
' if StartDate isn't a workday, then loop for a workday
Do
ShType = ShiftType(StartDate)
If ShType <> NshNoShift Then Exit Do
StartDate = StartDate + 1
Loop
If StartDate < CommenceTime Then
' StartDate is a workday:
If CommenceTime > (StartDate + EndTime(ShType)) Then
StartDate = StartDate + 1
End If
End If
If StartDate < CommenceTime Then
CommenceTime = CommenceTime - StartDate
CommenceTime = Application.Max(CommenceTime, StartTime(ShType))
Else
CommenceTime = StartTime(ShType)
End If
AdjustedStartTime = CommenceTime + StartDate
End Function
The FormatCells procedure is the sole survivor from March 25. I believe you have taken complete charge of it and know how to modify it to do what you want if it doesn't do so on its own.
There are three more new procedures which you can paste at the bottom of your code sheet (not the one with the even procedure). ShiftType is the function which refers to the SpecialDays and determines which, if any, are the start and end times for the daily shift.
Private Function ShiftType(ByVal ShiftDate As Double) As Nsh
' 28 Mar 2017
Dim Fun As Nsh
Dim Rng As Range, Fnd As Range
Dim Fmt As String
ShiftDate = Int(ShiftDate)
Set Rng = ThisWorkbook.Names(SpecialDays).RefersToRange.Columns(1)
With Rng
Fmt = .Cells(1).NumberFormat
.NumberFormat = "General"
Set Fnd = .Find(What:=ShiftDate, LookIn:=xlFormulas)
.NumberFormat = Fmt
End With
If Fnd Is Nothing Then
Fun = Application.Weekday(ShiftDate)
If (Fun = vbSaturday) Or (Fun = vbSunday) Then
Fun = NshNoShift
Else
Fun = NshFullShift
End If
Else
Fun = CLng(Val(Fnd.Offset(0, 1).Value))
Fun = Application.Min(Fun, NshNoShift)
Fun = Application.Max(Fun, NshFullShift)
End If
ShiftType = Fun
End Function
The last two functions return the StartTime and EndTime depending upon the ShiftType. Note that they return 0 (zero) for off-days.
Private Function StartTime(ShType As Nsh) As Double
' 28 Mar 2017
On Error Resume Next
StartTime = NshToDays(Array(NshStart, NshHalfStart, 0)(ShType))
Err.Clear
End Function
Private Function EndTime(ShType As Nsh) As Double
' 28 Mar 2017
On Error Resume Next
EndTime = NshToDays(Array(NshEnd, NshHalfEnd, 0)(ShType))
Err.Clear
End Function
Basically, your code works as before but it has become a lot more complex, meaning it has a lot more points where something may have gone without sufficient attention. My hope is that you will be able to find the procedure responsible for any fault you might discover and either can fix it yourself. After all, each procedure is rather simple in itself. Good luck!