Production planing with VBA

B

Bangla

New Member
Joined
Aug 24, 2020
Messages
4
Office Version
  1. 2010
Platform
  1. Windows
Dear All,

pls help...
I have many items to be produced in one production line. I have production qty, pieces per hour and now I have to make daily production plan.

In basic view it looks like this:

1598278326053.png

I want to make VBA code to authomaticaly make daily plan, values are QTY, hour rate, working hours per day.

I know You are all enthusiast and not get any financial satisfaction for help to me but I would be very happy about any help or suggestion from Your side who has more experience in Excel as me.

Thank You in advance.
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
helping_planning.xlsm
ABCDEFGHIJKLMNO
1SNITEMQTYPCS/HRWRK HRS/PER DAYDAILY OUTPUTSTARTING DATEDayItemQTYPCS/HRWRK HOURSDaily Input
2120560032001001024/08/202024/08/20202056003200100101000
3220581365001501025/08/20202056002200100101000
426/08/20202056001200100101000
527/08/2020205600200100101000
628/08/202020560001002200
728/08/2020205813630015081200
831/08/20202058135100150101500
901/09/20202058133600150101500
1002/09/20202058132100150101500
1103/09/2020205813600150101500
1204/09/202020581301505,33800
Folha1


VBA Code: 
Sub production_planning()

Dim sd As Date
Dim wh As Integer '-WORKING HOURS
Dim qt As Long 'QTY
Dim pc_hr As Integer '--PCS/HR
Dim hr_qt As Double 'NECESSARIES HOURS TO PRODUCT THE QTY = QT/PC_HR
Dim hr_qt_t As Double 'NECESSARIES HOURS TO PRODUCT THE QTY BUT NOT ON 10 HOURS, LESS.
Dim item As Range
Dim lastrow_item As Integer
Dim lastrow_plan As Integer
Dim n_items As Integer
Dim i As Integer

i = 2
'Cells(i + 1, 10).Value = DateAdd("d", 1, Cells(i, 10).Value)
 
'--STARTING DATE
sd = ActiveSheet.Range("H2").Value

'--N ITEMS
lastrow_item = Cells(Rows.Count, "A").End(xlUp).Row
n_items = ActiveSheet.Range(("A") & lastrow_item).Value + 1



'ActiveSheet.Range("J2").Value = sd


For Each item In ActiveSheet.Range(("B2:B") & n_items)
        qt = item.Offset(0, 1).Value
        pc_hr = item.Offset(0, 2).Value
        hr_qt = qt / pc_hr
        lastrow_plan = Cells(Rows.Count, "K").End(xlUp).Row
        wh = item.Offset(0, 3).Value
        'ActiveSheet.Range("N" & lastrow_plan + 1).Value = wh
        Do While Not hr_qt < 0
            
            If i = 2 Then
                Cells(i, 11).Value = item
                Cells(i, 10).Value = sd
                Cells(i, 12).Value = qt
                Cells(i, 13).Value = pc_hr
                Cells(i, 14).Value = wh
    
            Else
'                If Cells(i - 1, 12).Value = 0 Then
'                hr_qt = wh - Cells(i, 14).Value
'                Else
'
'                End If
            End If
            If item <> Cells(i, 11).Value Then
            Else
            hr_qt = hr_qt - Cells(i, 14).Value
            End If
            If hr_qt < 0 Then
                hr_qt_t = Cells(i - 1, 14).Value - Abs(hr_qt)
                Cells(i + 1, 13).Value = pc_hr
                Cells(i, 15).Value = Cells(i, 13).Value * Cells(i, 14).Value
                Cells(i + 1, 12).Value = 0
                Cells(i + 1, 11).Value = item
                Cells(i + 1, 10).Value = Application.WorkDay(Cells(i, 10).Value, 1)
                Cells(i + 1, 14).Value = hr_qt_t
            
            ElseIf item <> Cells(i, 11).Value Then
                    Cells(i + 1, 11).Value = item
                    Cells(i + 1, 13).Value = pc_hr
                    If Cells(i, 14).Value < wh Then
                        Cells(i + 1, 14).Value = wh - Cells(i, 14).Value
                        Cells(i + 1, 10).Value = Cells(i, 10).Value
                    ElseIf Cells(i, 14).Value = 10 Then
                        Cells(i + 1, 10).Value = Application.WorkDay(Cells(i, 10).Value, 1)
                        Cells(i + 1, 14).Value = wh
                    End If
                    Cells(i + 1, 15).Value = Cells(i + 1, 13).Value * Cells(i + 1, 14).Value
                    Cells(i + 1, 12).Value = qt - Cells(i, 13).Value * Cells(i, 14).Value
                    
            Else
                Cells(i + 1, 13).Value = pc_hr
                Cells(i, 15).Value = Cells(i, 13).Value * Cells(i, 14).Value
                Cells(i + 1, 12).Value = Cells(i, 12).Value - Cells(i, 15)
                Cells(i + 1, 11).Value = item
                Cells(i + 1, 10).Value = Application.WorkDay(Cells(i, 10).Value, 1)
                Cells(i + 1, 14).Value = wh
                
            End If
        Cells(i, 15).Value = Cells(i, 13).Value * Cells(i, 14).Value
         i = i + 1
         Loop
Cells(i, 15).Value = Cells(i, 13).Value * Cells(i, 14).Value
Next item
        
        

End Sub

Hope it works.
Painted as gray, means that you have to fill in order to work.
 
Upvote 0
Dear tico_ocit,

many thanks for Your engagement.
I have tested but there some problem coming.
Pls see

1598346780222.png


Can You maybe help me one more time, pls?

Thank You in advance,

Sincerely Yours,

Bangla
 
Upvote 0
Try this. It's not the best code, but I took 3/4 hours working on this...
I'm an Industrial Management Engineer so I know what planning production is all about. So on this you have to take a lot of things in consideration!
This is thought in order to you know what do you have to produce on a certain day.
Test and say something.
VBA Code: 
Sub production_planning()

Dim sd As Date
Dim wh As Integer '-WORKING HOURS
Dim qt As Long 'QTY
Dim pc_hr As Integer '--PCS/HR
Dim hr_qt As Double 'NECESSARIES HOURS TO PRODUCT THE QTY = QT/PC_HR
Dim hr_qt_t As Double 'NECESSARIES HOURS TO PRODUCT THE QTY BUT NOT ON 10 HOURS, LESS.
Dim item As Range
Dim lastrow_item As Integer
Dim lastrow_plan As Integer
Dim n_items As Integer
Dim i As Integer
Dim wh_d As Double ' WORKING DAYS LEFT OF THE 10 PER DAY

i = 2

 
'--STARTING DATE
sd = ActiveSheet.Range("H2").Value

'--N ITEMS
lastrow_item = Cells(Rows.Count, "A").End(xlUp).Row
n_items = ActiveSheet.Range(("A") & lastrow_item).Value + 1

lastrow_plan = Cells(Rows.Count, "J").End(xlUp).Row

If lastrow_plan = 1 Then
Else
ActiveSheet.Range("J2:O" & lastrow_plan).ClearContents
End If



For Each item In ActiveSheet.Range(("B2:B") & n_items)
        qt = item.Offset(0, 1).Value
        pc_hr = item.Offset(0, 2).Value
        hr_qt = qt / pc_hr
        lastrow_plan = Cells(Rows.Count, "K").End(xlUp).Row
        wh = item.Offset(0, 3).Value
        'ActiveSheet.Range("N" & lastrow_plan + 1).Value = wh
        Do While Not hr_qt <= 0
            
            If ActiveSheet.Range("J2").Value = "" Then
                Cells(i, 11).Value = item
                Cells(i, 10).Value = sd
                Cells(i, 12).Value = qt
                Cells(i, 13).Value = pc_hr
                Cells(i, 14).Value = wh
                Cells(i, 15).Value = pc_hr * wh
                wh_d = wh
                hr_qt = hr_qt - Cells(i, 14).Value
            Else
            End If
            If hr_qt < 0 Then
                    If i = 2 Then
                        hr_qt_t = Cells(i, 14).Value - (hr_qt * -1)
                    Else
                         hr_qt_t = Cells(i - 1, 14).Value - (hr_qt * -1)
                    End If
               
                Cells(i + 1, 13).Value = pc_hr
                Cells(i, 15).Value = Cells(i, 13).Value * Cells(i, 14).Value
                Cells(i + 1, 12).Value = 0
                Cells(i + 1, 11).Value = item
                Cells(i + 1, 10).Value = Application.WorkDay(Cells(i, 10).Value, 1)
                Cells(i + 1, 14).Value = hr_qt_t
                hr_qt = hr_qt - Cells(i, 14).Value
            ElseIf hr_qt = 0 Then
                GoTo continueloop
            ElseIf item <> Cells(i, 11).Value Then
                    Cells(i + 1, 11).Value = item
                    Cells(i + 1, 13).Value = pc_hr
                    If Cells(i, 14).Value < wh Then
                                If wh_d = 0 Then
                                    Cells(i + 1, 10).Value = Application.WorkDay(Cells(i, 10).Value, 1)
                                    Cells(i + 1, 14).Value = wh
                                    wh_d = wh
                                Else
                                    Cells(i + 1, 12).Value = qt
                                    If (Cells(i + 1, 12).Value / pc_hr) > wh Then
                                        Cells(i + 1, 14).Value = wh_d
                                    ElseIf (Cells(i + 1, 12).Value / pc_hr) > wh_d Then
                                        Cells(i + 1, 14).Value = wh_d
                                    Else
                                    Cells(i + 1, 14).Value = Cells(i + 1, 12).Value / pc_hr
                                    End If
                                    Cells(i + 1, 10).Value = Cells(i, 10).Value
                                    wh_d = wh_d - Cells(i + 1, 14).Value
                                End If
                    ElseIf wh_d = 10 Then
                                    Cells(i + 1, 10).Value = Application.WorkDay(Cells(i, 10).Value, 1)
                                    Cells(i + 1, 14).Value = wh
                                    wh_d = wh
                    End If
                    Cells(i + 1, 15).Value = Cells(i + 1, 13).Value * Cells(i + 1, 14).Value
                    Cells(i + 1, 12).Value = qt
                    hr_qt = hr_qt - Cells(i + 1, 14).Value
                         
            Else
                Cells(i + 1, 13).Value = pc_hr
                Cells(i, 15).Value = Cells(i, 13).Value * Cells(i, 14).Value
                Cells(i + 1, 12).Value = Cells(i, 12).Value - Cells(i, 15)
                Cells(i + 1, 11).Value = item
                Cells(i + 1, 10).Value = Application.WorkDay(Cells(i, 10).Value, 1)
                If (Cells(i + 1, 12).Value / pc_hr) > wh Then
                    Cells(i + 1, 14).Value = wh
                Else
                    Cells(i + 1, 14).Value = Cells(i + 1, 12).Value / pc_hr
                    wh_d = wh
                    wh_d = wh_d - Cells(i + 1, 14).Value
                End If
                Cells(i + 1, 15).Value = Cells(i + 1, 13).Value * Cells(i + 1, 14).Value
                hr_qt = hr_qt - Cells(i + 1, 14).Value
            End If

         i = i + 1

         Loop
continueloop:
Next item
        
        

End Sub
 
Upvote 0
tico_ocit said:
Try this. It's not the best code, but I took 3/4 hours working on this...
I'm an Industrial Management Engineer so I know what planning production is all about. So on this you have to take a lot of things in consideration!
This is thought in order to you know what do you have to produce on a certain day.
Test and say something.
VBA Code: 
Sub production_planning()

Dim sd As Date
Dim wh As Integer '-WORKING HOURS
Dim qt As Long 'QTY
Dim pc_hr As Integer '--PCS/HR
Dim hr_qt As Double 'NECESSARIES HOURS TO PRODUCT THE QTY = QT/PC_HR
Dim hr_qt_t As Double 'NECESSARIES HOURS TO PRODUCT THE QTY BUT NOT ON 10 HOURS, LESS.
Dim item As Range
Dim lastrow_item As Integer
Dim lastrow_plan As Integer
Dim n_items As Integer
Dim i As Integer
Dim wh_d As Double ' WORKING DAYS LEFT OF THE 10 PER DAY

i = 2


'--STARTING DATE
sd = ActiveSheet.Range("H2").Value

'--N ITEMS
lastrow_item = Cells(Rows.Count, "A").End(xlUp).Row
n_items = ActiveSheet.Range(("A") & lastrow_item).Value + 1

lastrow_plan = Cells(Rows.Count, "J").End(xlUp).Row

If lastrow_plan = 1 Then
Else
ActiveSheet.Range("J2:O" & lastrow_plan).ClearContents
End If



For Each item In ActiveSheet.Range(("B2:B") & n_items)
        qt = item.Offset(0, 1).Value
        pc_hr = item.Offset(0, 2).Value
        hr_qt = qt / pc_hr
        lastrow_plan = Cells(Rows.Count, "K").End(xlUp).Row
        wh = item.Offset(0, 3).Value
        'ActiveSheet.Range("N" & lastrow_plan + 1).Value = wh
        Do While Not hr_qt <= 0
          
            If ActiveSheet.Range("J2").Value = "" Then
                Cells(i, 11).Value = item
                Cells(i, 10).Value = sd
                Cells(i, 12).Value = qt
                Cells(i, 13).Value = pc_hr
                Cells(i, 14).Value = wh
                Cells(i, 15).Value = pc_hr * wh
                wh_d = wh
                hr_qt = hr_qt - Cells(i, 14).Value
            Else
            End If
            If hr_qt < 0 Then
                    If i = 2 Then
                        hr_qt_t = Cells(i, 14).Value - (hr_qt * -1)
                    Else
                         hr_qt_t = Cells(i - 1, 14).Value - (hr_qt * -1)
                    End If
             
                Cells(i + 1, 13).Value = pc_hr
                Cells(i, 15).Value = Cells(i, 13).Value * Cells(i, 14).Value
                Cells(i + 1, 12).Value = 0
                Cells(i + 1, 11).Value = item
                Cells(i + 1, 10).Value = Application.WorkDay(Cells(i, 10).Value, 1)
                Cells(i + 1, 14).Value = hr_qt_t
                hr_qt = hr_qt - Cells(i, 14).Value
            ElseIf hr_qt = 0 Then
                GoTo continueloop
            ElseIf item <> Cells(i, 11).Value Then
                    Cells(i + 1, 11).Value = item
                    Cells(i + 1, 13).Value = pc_hr
                    If Cells(i, 14).Value < wh Then
                                If wh_d = 0 Then
                                    Cells(i + 1, 10).Value = Application.WorkDay(Cells(i, 10).Value, 1)
                                    Cells(i + 1, 14).Value = wh
                                    wh_d = wh
                                Else
                                    Cells(i + 1, 12).Value = qt
                                    If (Cells(i + 1, 12).Value / pc_hr) > wh Then
                                        Cells(i + 1, 14).Value = wh_d
                                    ElseIf (Cells(i + 1, 12).Value / pc_hr) > wh_d Then
                                        Cells(i + 1, 14).Value = wh_d
                                    Else
                                    Cells(i + 1, 14).Value = Cells(i + 1, 12).Value / pc_hr
                                    End If
                                    Cells(i + 1, 10).Value = Cells(i, 10).Value
                                    wh_d = wh_d - Cells(i + 1, 14).Value
                                End If
                    ElseIf wh_d = 10 Then
                                    Cells(i + 1, 10).Value = Application.WorkDay(Cells(i, 10).Value, 1)
                                    Cells(i + 1, 14).Value = wh
                                    wh_d = wh
                    End If
                    Cells(i + 1, 15).Value = Cells(i + 1, 13).Value * Cells(i + 1, 14).Value
                    Cells(i + 1, 12).Value = qt
                    hr_qt = hr_qt - Cells(i + 1, 14).Value
                       
            Else
                Cells(i + 1, 13).Value = pc_hr
                Cells(i, 15).Value = Cells(i, 13).Value * Cells(i, 14).Value
                Cells(i + 1, 12).Value = Cells(i, 12).Value - Cells(i, 15)
                Cells(i + 1, 11).Value = item
                Cells(i + 1, 10).Value = Application.WorkDay(Cells(i, 10).Value, 1)
                If (Cells(i + 1, 12).Value / pc_hr) > wh Then
                    Cells(i + 1, 14).Value = wh
                Else
                    Cells(i + 1, 14).Value = Cells(i + 1, 12).Value / pc_hr
                    wh_d = wh
                    wh_d = wh_d - Cells(i + 1, 14).Value
                End If
                Cells(i + 1, 15).Value = Cells(i + 1, 13).Value * Cells(i + 1, 14).Value
                hr_qt = hr_qt - Cells(i + 1, 14).Value
            End If

         i = i + 1

         Loop
continueloop:
Next item
      
      

End Sub
Click to expand...


Dear tico_ocit,

thank You!!!
WBR
 
Last edited by a moderator:
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
VBA script for checking date, matching date, and publishing data in corresponding cell
Replies
1
Views
64
kshealy
K
P
  • Solved
VLOOKUP (or VBA Alternative?) From another workbook, depending on Financial Year
Replies
2
Views
84
paun_shotts
P
Z
  • Question
Excel Help
Replies
1
Views
184
Georgiboy
Georgiboy
B
  • Solved
If field is blank divide by a different cell
Replies
8
Views
134
BigD1980
B
J
  • Solved
Copying the data from another spreadsheet for specific product
Replies
2
Views
139
junaidaun
J

Forum statistics

Threads
1,215,734
Messages
6,126,542
Members
449,316
Latest member
sravya

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top