Can anyone help me improve the following? .. I have data that looks like this –

Quantity Purchased ------ Quantity Sold

50,000 -------------------- 40,000

25,000 -------------------- 20,000

150,000 ------------------- 25,000

45,000 --------------------- 100,000

80,000 --------------------- 20,000

20,000

10,000

These amounts are entered sequentially in a worksheet that functions like a database. As a rule, an item cannot be sold before it has been purchased, which means that the total number of items purchased is at least equal to the number of items sold.

What I am trying to do is write a macro that will compare how much of the item was sold to how much was purchased and give me the difference on a first-in-first-out basis, so that if the amount purchased is greater than the amount sold, then the amount sold should come from the first block of purchases. In a second run, this should work in the same way until the first block is empty. If something remains in the amount sold that has not been deducted from inventory, it should be removed from the second block of purchases, then from the next etc. At the end, I should get the following :

Result

0

0

20,000

45,000

80,000

20,000

10,000

The sum of “Result” + “Quantity Sold” should equal “Quantity Purchased”.

I started with the following and can more or less isolate the data but where I get really stuck is in the middle (after “Redim”). My guess is for this to work properly I should check whether the quantity in QuantP(i) = 0, if no, deduct QuantS(i) from it until QuantP(i) = 0, then check if something remains, if yes move on to the next QuantP, but if I put “QuantP(i + 1)” in the macro, I’ll get “subscript out of range”, so basically my problem is how do I translate all the above into VBA??

Many thanks to anyone who can help!

Sub Test ()

Sheets("Products").Activate

Range("MyRange").Select

Dim QuantP()

Dim QuantS()

Dim Result()

CountRows = Selection.CurrentRegion.Rows.Count + 1

CountP = 1

CountS = 1

For i = 1 To CountRows

If Range("c" & i).Value = "Item A" And Range("B" &i).Value = "Purchased" Then

ReDim Preserve QuantP(CountP)

QuantP(CountP) = Range("K" & i).Value

CountP = CountP + 1

End If

Next i

For j = 1 To CountRows

If Range("c" & j).Value = "Item A” And Range("B" & j).Value = "Sold" Then

ReDim Preserve QuantS(CountS)

QuantS(CountS) = Range("K" & j).Value

CountS = CountS + 1

End If

Next j

ReDim Resultat(1 To CountP)

For i = 1 To UBound(QuantP)

If i <= UBound(QuantS) Then

If QuantP(i) > QuantS(i) Then

Result(i) = QuantP(i) - QuantS(i)

QuantP(i) = Result(i)

ElseIf QuantP(i) < QuantS(i) Then

Result(i) = ?????

End If

End If

Next i

Sheets("sheet2").Activate

For k = 1 to UBound(Result)

Cells(k + 1, 1).Value = Result(k)

next k

End Sub