On 14 Dec, 10:35, Bogdan wrote:
Hi everyone,

I would like to create a script similar with FIFO (first-in first out)
method, but instead of taking out the oldest item from stock, it should take
out the stock with the smallest (minimum) acquisition price. For instance if
I have:

*Type * * Date * *Number * * * Acquisition * * * * *Lot
* * * * * * * * * * * * * * * * * *of units * * *price per unit

IN * * *29-Oct-08 * * * * * * 3,000 * * * * * *7.8500 * * * * * * * 1
IN * * *30-Oct-08 * * * * * 75,000 * * * * * * 7.9000 * * * * * * * 2
IN * * *06-Nov-08 * * * * * * 7,500 * * * * * *7.8000 * * * * * * * 3
OUT * * 25-Nov-08 * * * * * 12,500 * * * * * * 8.1027

On 25th of November the quantity of 12,500 units should be taken out in the
following order:
- first 7,500 units from Lot 3, as this lot has the smallest acquisition price
- the following 3,000 units from Lot 1, as this lot has the minimum
available acquisition price
- the difference of 2,000 unit from lot 2

I hope I was pretty concise in my explanantions.

Can anyone help me?

Many thanks in advance,

Bogdan


Phillip London UK

Assumptions
Nothing in colum F
An empty row between your OUT rows and
your IN roews
Your IN data starts in A1

This works for me

Sub test()
Dim instock As Long
Dim rngAcq As Range
Dim rngStock As Range
Dim rngDB As Range
Dim OutAmount As Long
Dim StockAccum As Long
Dim x As Long

Set rngDB = ActiveSheet.Range("a1").CurrentRegion.Cells
Set rngLot = rngDB.Columns(5).Cells
Set rngAcq = rngDB.Columns(4).Cells
Set rngStock = rngDB.Columns(3).Cells
instock = WorksheetFunction.Sum(rngStock)

OutAmount = Application.InputBox("Enter OUT amount", "Stock
out", , , , , 1)
rngDB.Sort key1:=rngAcq.Cells(1), header:=xlGuess
StockAccum = 0
x = 2
Do While StockAccum < OutAmount
StockAccum = rngStock.Cells(x).Value + StockAccum
If StockAccum < OutAmount Then
rngStock.Cells(x).Value = 0
x = x + 1
ElseIf StockAccum = OutAmount Then
rngStock.Cells(x).Value = 0
ElseIf StockAccum OutAmount Then
rngStock.Cells(x).Value = StockAccum - OutAmount
End If
Loop
rngDB.Sort key1:=rngLot.Cells(1), header:=xlGuess
End Sub