How can this be improved? an annoying FIFO problem

[dalian]

Hello,

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

 

[jindon]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a(), i As Long, x As Double
If Intersect(Target, Range("a:b")) Is Nothing Then Exit Sub
With Application
     With .WorksheetFunction
           x = .Sum(Range("a:a")) - Range("b:b"))
     End With
     If (Not IsNumeric(Target.Value)) + (x < 0) + (Target.Count > 1) Then
          MsgBox "Invalid entry/selection"
          .EnableEvents = False
          .Undo
          .EnableEvents = True
          Exit Sub
     End If
End With
a = Range("a1").CurrentRegion.Resize(,2).Value
ReDim Preserve a(1 To UBound(a,1), 1 To 3)
For i = 2 To UBound(a,1)
     If IsEmpty(a(i,2)) Then a(i,2) = 0
     If x > 0 Then
          If a(i,2) >= x Then
               a(i,3) = a(i,2) - x : x = 0
          Else
               a(i,3) = 0 : x = x - a(i,3)
          End If
     Else
          a(i,3) = a(i,2)
     End If
Next
Application.EnableEvents = False
Range("a1").CurrentRegion.Resize(,3).Value = a
Application.EnableEvents = True
End Sub

 

[dalian]

Hi Jindon,

Thanks for your help but I still have problems : what I need is a macro that will compute inventory in a(i,2) until a(i,3) is empty, and if that is not the case, subtract from it until it is but I don't know how to express that in Vba!

 

[jindon]

Hi Jindon,

Thanks for your help but I still have problems : what I need is a macro that will compute inventory in a(i,2) until a(i,3) is empty, and if that is not the case, subtract from it until it is but I don't know how to express that in Vba!

a(i,3) is an inventry of the purchase of that line, so at the beggining everything is empty at the start. Don't understand what you mean.

Is there any possiblity to have empty cell(s) in the data area of col.B?
I mean something like
Col.B
1000
500
Empty
200
Empty
300

 

[dalian]

No, column B cannot have empty or zero values, but I can't seem to make this work !

 

[jindon]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a(), i As Long, x As Double, y As Double
If Intersect(Target, Range("a:b")) Is Nothing Then Exit Sub
With Application
     With .WorksheetFunction
           y = .Sum(Range(b:b))
           x = .Sum(Range("a:a")) - Range("b:b"))
     End With
     If (Not IsNumeric(Target.Value)) + (x < 0) + (Target.Count > 1) Then
          MsgBox "Invalid entry/selection"
          .EnableEvents = False
          .Undo
          .EnableEvents = True
          Exit Sub
     End If
End With
a = Range("a1").CurrentRegion.Resize(,2).Value
ReDim Preserve a(1 To UBound(a,1), 1 To 3)
For i = 2 To UBound(a,1)
     If IsEmpty(a(i,2)) Then a(i,2) = 0
     If y > 0 Then
          If a(i,2) >= y Then
               a(i,3) = a(i,2) - y : y = 0
          Else
               a(i,3) = 0 : y = y - a(i,3)
          End If
     Else
          a(i,3) = a(i,2)
     End If
Next
Application.EnableEvents = False
Range("a1").CurrentRegion.Resize(,3).Value = a
Application.EnableEvents = True
End Sub