How do I create a fifo function in Excel

I need to create a fifo function for price calculation.

I have a table with the following layout:

Purchase_date   Quantity  Purchase_Price 
----------------------------------------
2011-01-01      1000      10
2011-01-02      2000      11
......

Sale_date       Quantity  Costprice
----------------------------------------
2011-02-01      50        =fifo_costprice(...

the Fifo formula works like:

fifo_costprice(Q_sold_to_date as float, Quantity_purchased as range
               , Purchase_Prices as range) a开发者_开发问答s float

How do I do this in Excel VBA?

Here's what I came up with to start, it doesn't do any error checking and date matching, but it works.

Public Function fifo(SoldToDate As Double, Purchase_Q As Range, _ 
                     Purchase_price As Range) As Double
Dim RowOffset As Integer
Dim CumPurchase As Double
Dim Quantity As Range
Dim CurrentPrice As Range

  CumPurchase = 0
  RowOffset = -1
  For Each Quantity In Purchase_Q
    CumPurchase = CumPurchase + Quantity.Value
    RowOffset = RowOffset + 1
    If CumPurchase > SoldToDate Then Exit For
  Next
  'if sold > total_purchase, use the last known price.
  Set CurrentPrice = Purchase_price.Cells(1, 1).offset(RowOffset, 0)
  fifo = CurrentPrice.Value
End Function

I had a similar problem finding the "most recent exchange rate" via VBA. This is my code, maybe it can inspire you ...

Function GetXRate(CurCode As Variant, Optional CurDate As Variant) As Variant
Dim Rates As Range, chkDate As Date
Dim Idx As Integer

    GetXRate = CVErr(xlErrNA)                                   ' set to N/A error upfront
    If VarType(CurCode) <> vbString Then Exit Function          ' if we didn't get a string, we terminate
    If IsMissing(CurDate) Then CurDate = Now()                  ' if date arg not provided, we take today
    If VarType(CurDate) <> vbDate Then Exit Function            ' if date arg provided but not a date format, we terminate

    Set Rates = Range("Currency")                               ' XRate table top-left is a named range
    Idx = 2                                                     ' 1st row is header row
                                                                ' columns: 1=CurCode, 2=Date, 3=XRate

    Do While Rates(Idx, 1) <> ""
        If Rates(Idx, 1) = CurCode Then
            If Rates(Idx, 2) = "" Then
                GetXRate = Rates(Idx, 3)                        ' rate without date is taken at once
                Exit Do
            ElseIf Rates(Idx, 2) > chkDate And Rates(Idx, 2) <= CurDate Then
                GetXRate = Rates(Idx, 3)                        ' get rate but keep searching for more recent rates
                chkDate = Rates(Idx, 2)                         ' remember validity date
            End If
        End If
        Idx = Idx + 1
    Loop
End Function

It's more a classical loop construct with a loop index (Idx as Integer) and two exit criteria, so I don't need to go across all rows under all circumstances.