Help! Production plan by Shift 1

[ongke0711]

Dear All,

Please help me this task.
- I have a Production plan for product A, B, C....
- Each product has a production time. Ex: Product_A: need 100 hours to finish all required Quantity.
- I have 3 shifts per day. Total producing time per shift: Shift 1 - 126 hours; Shift 2 - 119 hours; Shift 3 - 140 hours.
=> I need a detail plan production by Product and by Shift. How much time each shift can use to make a product until finish. Finish product A and go to product B, C ...
Please see attached picture for more clearly.

I attached the demo mdb file: Link

(Ps: My English is not so good, please sympathize)

 

[MajP]

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

Results

[tt]
ProductName  ShiftName	ShiftHours ProductionDate
Product_A	Shift1	100	8/5/2016
Product_B	Shift1	26	8/5/2016
Product_B	Shift2	89	8/5/2016
Product_C	Shift2	30	8/5/2016
Product_C	Shift3	48	8/5/2016
Product_D	Shift3	92	8/5/2016
Product_D	Shift1	126	8/8/2016
Product_D	Shift2	119	8/8/2016
Product_D	Shift3	23	8/8/2016
Product_E	Shift3	117	8/8/2016
Product_E	Shift1	43	8/9/2016
Product_F	Shift1	43	8/9/2016
Product_G	Shift1	40	8/9/2016
Product_G	Shift2	119	8/9/2016
Product_G	Shift3	140	8/9/2016
Product_G	Shift1	51	8/10/2016
Product_H	Shift1	75	8/10/2016
Product_H	Shift2	119	8/10/2016
Product_H	Shift3	13	8/10/2016
Product_I	Shift3	127	8/10/2016
Product_I	Shift1	126	8/11/2016
Product_I	Shift2	65	8/11/2016
Product_K	Shift2	54	8/11/2016
Product_K	Shift3	140	8/11/2016
Product_K	Shift1	118	8/12/2016
Product_L	Shift1	8	8/12/2016
Product_L	Shift2	119	8/12/2016
Product_L	Shift3	3	8/12/2016
Product_M	Shift3	137	8/12/2016
Product_M	Shift1	126	8/15/2016
Product_M	Shift2	9	8/15/2016
[/tt]

 

[ongke0711]

Hi MajP,

It works like a charm!
Thank you very much for your help. Very fast response! I really appreciate that.