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

LoganJBass · Jan 11, 2016

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
[TABLE="width: 782"]
<tbody>[TR]
[TD]Planned dates[/TD]
[TD]Needed Date after Changes[/TD]
[TD]MRP elemnt[/TD]
[TD]MRP elmnt data[/TD]
[TD]Rescheduling date[/TD]
[TD]Exception[/TD]
[TD]Rec./reqd qty[/TD]
[TD]Avail. quantity[/TD]
[TD]Stor. Loc.[/TD]
[TD]Model/Eff[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Stock[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]0.000[/TD]
[TD]7[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1/1/2016[/TD]
[TD][/TD]
[TD]SubReq[/TD]
[TD]60P5700000A001[/TD]
[TD][/TD]
[TD][/TD]
[TD]-1[/TD]
[TD]6[/TD]
[TD][/TD]
[TD="align: right"]6213[/TD]
[/TR]
[TR]
[TD]1/17/2016[/TD]
[TD][/TD]
[TD]SubReq[/TD]
[TD]60P5700000A001[/TD]
[TD][/TD]
[TD][/TD]
[TD]-1[/TD]
[TD]5[/TD]
[TD][/TD]
[TD="align: right"]6217[/TD]
[/TR]
[TR]
[TD]1/21/2016[/TD]
[TD][/TD]
[TD]DepReq[/TD]
[TD]60P2820021N003P02[/TD]
[TD][/TD]
[TD][/TD]
[TD]-1[/TD]
[TD]4[/TD]
[TD]1008[/TD]
[TD]GVI/6200[/TD]
[/TR]
[TR]
[TD]1/27/2016[/TD]
[TD][/TD]
[TD]DepReq[/TD]
[TD]60P2820021N003P02[/TD]
[TD][/TD]
[TD][/TD]
[TD]-1[/TD]
[TD]3[/TD]
[TD]1008[/TD]
[TD]GVI/6202[/TD]
[/TR]
[TR]
[TD]2/3/2016[/TD]
[TD][/TD]
[TD]DepReq[/TD]
[TD]60P2820021N003P02[/TD]
[TD][/TD]
[TD][/TD]
[TD]-1[/TD]
[TD]2[/TD]
[TD]1008[/TD]
[TD]GVI/6203[/TD]
[/TR]
[TR]
[TD]2/5/2016[/TD]
[TD][/TD]
[TD]SubReq[/TD]
[TD]60P5700000A001[/TD]
[TD][/TD]
[TD][/TD]
[TD]-1[/TD]
[TD]1[/TD]
[TD][/TD]
[TD="align: right"]6220[/TD]
[/TR]
[TR]
[TD]2/9/2016[/TD]
[TD][/TD]
[TD]DepReq[/TD]
[TD]60P2820021N003P02[/TD]
[TD][/TD]
[TD][/TD]
[TD]-1[/TD]
[TD]0[/TD]
[TD]1008[/TD]
[TD]GVI/6204[/TD]
[/TR]
[TR]
[TD]2/16/2016[/TD]
[TD][/TD]
[TD]DepReq[/TD]
[TD]60P2820021N003P02[/TD]
[TD][/TD]
[TD][/TD]
[TD]-1[/TD]
[TD]-1[/TD]
[TD]1008[/TD]
[TD]GVI/6205[/TD]
[/TR]
</tbody>[/TABLE]

Example of Sheet2
[TABLE="width: 825"]
<tbody>[TR]
[TD]Planned dates[/TD]
[TD]Needed Date after Changes[/TD]
[TD]MRP elemnt[/TD]
[TD]MRP elmnt data[/TD]
[TD]Rescheduling date[/TD]
[TD]Exception[/TD]
[TD]Rec./reqd qty[/TD]
[TD]Avail. quantity[/TD]
[TD]Stor. Loc.[/TD]
[TD]Model/Eff[/TD]
[/TR]
[TR]
[TD]1/28/2016[/TD]
[TD][/TD]
[TD]POitem[/TD]
[TD]4500018402/00010[/TD]
[TD][/TD]
[TD][/TD]
[TD]6[/TD]
[TD]6[/TD]
[TD]3003[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3/1/2016[/TD]
[TD][/TD]
[TD]POitem[/TD]
[TD]4500018402/00010[/TD]
[TD][/TD]
[TD][/TD]
[TD]4[/TD]
[TD]4[/TD]
[TD]3003[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3/22/2016[/TD]
[TD][/TD]
[TD]POitem[/TD]
[TD]4500018402/00010[/TD]
[TD][/TD]
[TD][/TD]
[TD]6[/TD]
[TD]6[/TD]
[TD]3003[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4/12/2016[/TD]
[TD][/TD]
[TD]POitem[/TD]
[TD]4500018402/00010[/TD]
[TD][/TD]
[TD][/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]3003[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

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

sijpie · Jan 13, 2016

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:

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?
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.

sijpie · Jan 14, 2016

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.

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

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

LoganJBass

New Member

sijpie

Well-known Member

sijpie

Well-known Member

Similar threads

Share this page

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

LoganJBass

New Member

sijpie

Well-known Member

sijpie

Well-known Member

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock