VBA - Need help/ideas on creating loop that simulates a MRP program such as SAP

LoganJBass

New Member
Joined
Jan 11, 2016
Messages
1
Hello,

This is my first post, so please forgive me if I post any noob/dumb stuff with this post. I'm a bit stumped though with regard to writing this macro. The premise of the Macro is to simulate MRP within Excel. The first procedure is a simple calculation that takes the starting stock level and adds it to the requirement to its left for each row until there are no more requirements. That part works dandy, but will take any all suggestions to improve.

The 2nd sub is the part that is throwing me for a loop. Pun intended. So once I have my "Line of Balance" calculated, I want to find the first negative in Column H and insert a row before that negative value and then copy and paste a different row from worksheet2 that represent the PO. Once that line is now added to the "Line of Balance", I want my loop to do the calculation again find the next negative value and so on....The catch is, I only want to insert a row in sheet 1 if there are rows available in sheet 2 that contain a PO line. Once there are no more PO lines, I want a msgbox to appear and say no more POs or something and the end the loop. The code below doesnt seem to pick up both of these conditions and instead processes every negative before recalculating and wants to insert a row regardless if it is a PO row.

Again excuse the poor excuse of example below, couldn't figure out the screenshot insert. Noob....

Thank you!

Example of Sheet1
Planned datesNeeded Date after ChangesMRP elemntMRP elmnt dataRescheduling dateExceptionRec./reqd qtyAvail. quantityStor. Loc.Model/Eff
Stock0.0007
1/1/2016SubReq60P5700000A001-166213
1/17/2016SubReq60P5700000A001-156217
1/21/2016DepReq60P2820021N003P02-141008GVI/6200
1/27/2016DepReq60P2820021N003P02-131008GVI/6202
2/3/2016DepReq60P2820021N003P02-121008GVI/6203
2/5/2016SubReq60P5700000A001-116220
2/9/2016DepReq60P2820021N003P02-101008GVI/6204
2/16/2016DepReq60P2820021N003P02-1-11008GVI/6205

<tbody>
</tbody>

Example of Sheet2
Planned datesNeeded Date after ChangesMRP elemntMRP elmnt dataRescheduling dateExceptionRec./reqd qtyAvail. quantityStor. Loc.Model/Eff
1/28/2016POitem4500018402/00010663003
3/1/2016POitem4500018402/00010443003
3/22/2016POitem4500018402/00010663003
4/12/2016POitem4500018402/00010553003

<tbody>
</tbody>
Code:
Option Explicit
Dim Stock As Variant
Dim QPS As Variant
Dim QPSMultiple As Variant
Dim LOB As Range
Dim Cell As Range
Dim MRPElement As Range
Dim C2 As String
Sub LOB_Cal()
'Calculates LOB through all listed requirements
Worksheets(1).Range("H3").Select
    Do Until ActiveCell.Offset(0, -1) = Empty
        ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + ActiveCell.Offset(0, -1).Value
        ActiveCell.Offset(1, 0).Select
    Loop
Worksheets(1).Range("H2").Select
End Sub
Sub Find_First_Negative_Value_In_LOB()
Set LOB = Worksheets(1).Range("H3:H150").Cells
Set MRPElement = Worksheets(2).Range("C2:C150")
If InStr(1, Worksheets(2).Range("C2").Value, "POitem", vbTextCompare) <> 0 Then
    For Each Cell In LOB
        If Cell.Value < 0 Then
            ActiveCell.EntireRow.Insert
            Worksheets(2).Activate
            ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:="POitem"
            ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Rows(1).EntireRow.Copy
            Worksheets(1).Activate
            Range("A1").End(xlDown).Offset(1, 0).Select
            ActiveCell.Select
            ActiveSheet.Paste
            Worksheets(2).Activate
            ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Rows(1).Delete
            Worksheets(1).Activate
            Worksheets(1).Range("F2").Select
            ActiveCell.Offset(1, 0).Select
                Do Until ActiveCell.Offset(0, -1) = Empty
                    ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + ActiveCell.Offset(0, -1).Value
                    Worksheets(1).Range("H3").Select
                Loop
        End If
    Next Cell
    For Each Cell In LOB
        If Cell.Value >= 0 Then
            Do Until ActiveCell.Offset(0, -1) = Empty
                ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + ActiveCell.Offset(0, -1).Value
                Worksheets(1).Range("H3").Select
            Loop
        End If
    Next Cell
End If
If InStr(1, Worksheets(2).Range("C2").Value, "POitem", vbTextCompare) = 0 Then
    MsgBox ("No More POs to Select")
    Worksheets(1).Range("H2").Select
End If
End Sub
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,795
Just a check: in your example the fisrt delivery date (planned date) in sheet2 is 28th Jan. but you only want to add it to the Sheet1 before the line of 16th Feb. is that correct?

Your code is a bit of a mess, so it'll take me a bit to sort it out.
In your code at several places you have this:
Code:
    For Each Cell In LOB
        If Cell.Value < 0 Then
            ActiveCell something, something
Do you mean ActiveCell, or do you mean the range you called Cell itself, going down the LOB column?

because the two are not the same.

A few pointers:
  1. do not name a variable with a name that is so similar to an Excel reserved name, when you read through the code would you easily spot the difference between Cells.Value and Cell.Value?
  2. Unless it is a very simple macro, don't use activecell or activesheet, because at some point you havent' a clue which is active. Furthermore, but I'll explain that later, selecting cells is very slow, and we can do nearly everything without having to activate sheets or select cells. Much faster.

let me know your answer to the question oat the top and I'll see what I can do.
 
Last edited:

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,795
I notice that you are setting the addition into column F instead of H, so that is probably one of the main reasons it was not working. Have a look at this code, it will be much more efficient. Read the comments to get some pointers and understand what I am doing. Let me know how you get on.

<font face=Calibri><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#007F00">' >>> Only declare variables here if they are shared between subs in this module. _<br>  >>> Else declare them inside the sub where they are used. Good practice.</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> vStock <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> vQPS <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> vQPSMultiple <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN><br><SPAN style="color:#007F00">' following three variables declared in Find_First_Negative. _<br>  If required elswhere then uncomment here and remove from Find_First_Negative</SPAN><br><SPAN style="color:#007F00">'Dim rLOB As Range</SPAN><br><SPAN style="color:#007F00">'Dim rCell As Range  ' <<< you had declared this as 'Cell as Range'. Very dangerous because it looks too much like internal name Cells</SPAN><br><SPAN style="color:#007F00">'Dim rMRPElement As Range</SPAN><br>Dim sC2 As <SPAN style="color:#00007F">String</SPAN>   <SPAN style="color:#007F00">' <<< you had declared this as 'C2 as string'. Again very dangerous because it  looks to much like a cell address.</SPAN><br><SPAN style="color:#007F00">' >>> notice how I added a type letter to the start of the variable name. It helps.</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> LOB_Cal()<br><SPAN style="color:#007F00">'Calculates LOB through all listed requirements</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> lRLast <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> wsOrders <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <br>    <SPAN style="color:#00007F">Set</SPAN> wsStock = Worksheets(1) <SPAN style="color:#007F00">' <<< even better would be to put the sheet name instead of 1</SPAN><br>    <br>    <SPAN style="color:#00007F">With</SPAN> wsStock<br>        lRLast = .Range("H3").End(xlDown).Row<br>        <SPAN style="color:#007F00">' set the formulas of the cells all at the same time. Very quick, no need to loop.</SPAN><br>        .Range("H3:H" & lRLast).Formula = "=H2+G3"<br>        <SPAN style="color:#007F00">' >>> if you want to turn the formulas into values then uncomment the next line <<<</SPAN><br>        <SPAN style="color:#007F00">' .Range("H3:H" & lRLast).value=.Range("H3:H" & lRLast).value</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br><br><SPAN style="color:#00007F">Sub</SPAN> Find_First_Negative_Value_In_LOB()<br><SPAN style="color:#007F00">' macro to insert available order into the stock sheet when the _<br>  available quantity would become negative.</SPAN><br>  <br>    <SPAN style="color:#00007F">Dim</SPAN> rLOB <SPAN style="color:#00007F">As</SPAN> Range, rCell <SPAN style="color:#00007F">As</SPAN> Range, rMRPElement <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> lRLast <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> wsOrders <SPAN style="color:#00007F">As</SPAN> Worksheet, wsStock <SPAN style="color:#00007F">As</SPAN> Worksheet<br><br>    <SPAN style="color:#007F00">' Use objects with meaningfull names so we know what we are doing in which sheet.</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wsStock = Worksheets(1) <SPAN style="color:#007F00">' <<< even better would be to put the sheet name instead of 1</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wsOrders = Worksheets(2)<br>    <br>    lRLast = wsOrders.Cells(Rows.Count, "C").End(xlUp).Row<br>    <SPAN style="color:#00007F">Set</SPAN> rMRPElement = wsOrders.Range("C2:C" & lRLast)<br>    lRLast = wsStock.Cells(Rows.Count, "H").End(xlUp).Row<br>    <SPAN style="color:#00007F">Set</SPAN> rLOB = wsStock.Range("H3:H" & lRLast)<br>    <br>    <SPAN style="color:#007F00">' Now go through each cell to check if it is negative. If so then add row and _<br>      move next order to the new row</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> InStr(1, wsOrders.Range("C2").Value, "POitem", vbTextCompare) <> 0 <SPAN style="color:#00007F">Then</SPAN><br>        <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> rCell <SPAN style="color:#00007F">In</SPAN> rLOB<br>            <SPAN style="color:#00007F">If</SPAN> rCell.Value < 0 <SPAN style="color:#00007F">Then</SPAN><br>                rCell.EntireRow.Insert<br>                lRLast = lRLast + 1<br>                wsOrders.UsedRange.AutoFilter Field:=3, Criteria1:="POitem"<br>                wsOrders.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Rows(1).EntireRow.Copy _<br>                    rCell.offest(-1, 0).EntireRow<br>                wsOrders.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Rows(1).Delete<br>                <SPAN style="color:#007F00">' update formulas in column H '<<< why were you updating column F??</SPAN><br>                LOB_Cal<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN> rCell<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> InStr(1, wsOrders.Range("C2").Value, "POitem", vbTextCompare) = 0 <SPAN style="color:#00007F">Then</SPAN><br>        MsgBox ("No More POs to Select")<br>        wsStock.Range("H2").Select<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,482
Messages
5,770,351
Members
425,612
Latest member
martinijr

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
Top