Public Sub CreatePlan(StartDay As Date)
Dim RS_Plan As DAO.Recordset
Dim RS_Shift As DAO.Recordset
Dim strSql As String
Dim ProductionHours As Long 'Total Required hours to product
Dim RemainingProductionHours As Long 'Current hours left to produce the item
Dim AvailableHours As Long 'Hours available from the shift
Dim UsedHours As Long 'Hours used by the shift
Dim TotalUsedHours As Long
Dim ProductName As String
Dim ProductionDate As Date
Dim DayCounter As Long
Dim ShiftName As String
Dim reccount As Long 'Number of shifts
'Get the Production plan in a recordset
strSql = "Select * from tblProductionPlan order by OrderProduction"
Set RS_Plan = CurrentDb.OpenRecordset(strSql)
'Get the shifts in a recordset
strSql = "Select * from tblShift order by shift"
Set RS_Shift = CurrentDb.OpenRecordset(strSql)
'Get the start values
ProductionDate = StartDay
AvailableHours = RS_Shift!TotalTimePerShift
ShiftName = RS_Shift!Shift
'Count the number of shift records
RS_Shift.MoveLast
RS_Shift.MoveFirst
'Clear current schedule. Need to make this table
CurrentDb.Execute "delete * from tblProductionSchedule"
reccount = RS_Shift.RecordCount
'Loop all products
Do While Not RS_Plan.EOF
ProductName = RS_Plan!ProductName
ProductionHours = RS_Plan!Quantity * RS_Plan!ProdTimePerUnit
RemainingProductionHours = ProductionHours
'Note you should not include total production time in the table. It should always be a calculated field
TotalUsedHours = 0
' Debug.Print RemainingProductionHours & " avail " & AvailableHours
Do
'The shift has remaining hours to complete the production
If AvailableHours >= RemainingProductionHours Then
UsedHours = RemainingProductionHours
TotalUsedHours = TotalUsedHours + UsedHours
AvailableHours = AvailableHours - RemainingProductionHours
RemainingProductionHours = 0
'The shift only has a portion needed to complete production
Else
UsedHours = AvailableHours
RemainingProductionHours = RemainingProductionHours - UsedHours
AvailableHours = 0
TotalUsedHours = TotalUsedHours + UsedHours
End If
'Debug.Print ProductName & " " & ShiftName & " " & UsedHours & " " & ProductionDate & " avail " & AvailableHours & " remainingProdHours " & RemainingProductionHours
strSql = "Insert into tblProductionschedule (ProductName, ShiftName, ShiftHours, ProductionDate) values ('" & ProductName & "', '" & ShiftName & "', " & UsedHours & ", #" & ProductionDate & "#)"
Debug.Print strSql
CurrentDb.Execute strSql
'The shift has no more hours so have to move to the next shift
If AvailableHours = 0 Then
'You are at the next shift so move to the first shift the next day
If RS_Shift.AbsolutePosition = reccount - 1 Then
RS_Shift.MoveFirst
'If the next day is saturday move to the next monday
'Delete this if you work weekends
If Weekday(ProductionDate) = vbFriday Then
ProductionDate = ProductionDate + 3
Else
ProductionDate = ProductionDate + 1
End If
Else
RS_Shift.MoveNext
End If
'Since you move to a new shift get the name and available shift hours
AvailableHours = RS_Shift!TotalTimePerShift
ShiftName = RS_Shift!Shift
End If
'If you completed production move to the next item
Loop Until TotalUsedHours = ProductionHours
RS_Plan.MoveNext
Loop
End Sub
Public Sub testPlan()
CreatePlan (Date)
End Sub
