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) as 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.