I try to better explain the problem using this screenshot as example:

As you can see from the screenshot, what's going here is the following:

• When an item is received, it is put on column G with the actual quantity received. Also an OrderID is associated to the item.
• Everytime an item is shipped, it is put in column A.

What I would like to achieve?

Everytime I ship an item, I would like to progressively subtract the quantity in column B to the first non-zero quantity in column H (corresponding to the same item I just put).

If I would be able to create a list ( as in C ) the pseudo code would be the following:

item = $A2;
While(item =/= blank){
 If(QuantityReceived > 0 && item == ItemReceived)
  QuantityReceived--;  ' here I just decrement by 1, because default quantity shipped is 1
 else {
  ItemReceived = ItemReceived -> next;
  QuantityReceived = QuantityReceived -> next;  
 }
ItemReceived = $G2;
QuantityReceived = $H2;
item = item -> next;
}

I wrote this code to explain what I would like to achieve.

Do you have any tips/solution/ideas?

Hope I explained the problem well.

Thanks.

CodePudding user response：

put this in the code for the sheet (not a module)

Private Sub Worksheet_Change(ByVal Target As Range)
    '
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Reference")
    
    Application.EnableEvents = True
    
    'restrict to users entering data in column B and only one cell
    If Target.Cells.Count = 1 And Target.Cells.Column = 2 Then
        ' get the item name depending on removed or add
        If Target.Value = 1 Then
            itemName = Target.Offset(0, -1).Value
            amt = -1
        ElseIf Target.Value = 0 Then
            itemName = ws.Range("A" & Target.Row).Value
            amt = 1
        Else
            End
        End If
        ' set up rng then look through all of the items in column G
        Dim rng As Range
        For Each rng In Range("G1:G" & Range("J" & Rows.Count).End(xlUp).Row)
            ' look for the item and a whats left of more than 0
            If rng.Value = itemName And rng.Offset(0, 3) > 0 Then
                rng.Offset(0, 3) = rng.Offset(0, 3)   amt
                ws.Columns("A:B").Clear
                
                lastrow = Range("A" & Range("A" & Rows.Count).End(xlUp).Row).Row
                ws.Range("A1:B" & lastrow).Value = Range("A1:B" & lastrow).Value
                Application.EnableEvents = True
                End
            End If
            
        Next rng
        ' message if item with positive left not found
            MsgBox ("no item remaining found")
    End If
End Sub

test and let me know how you get on / accept the answer if it works well for what you want