Home » excel » How do I create a fifo function in Excel

How do I create a fifo function in Excel

Posted by: admin May 14, 2020 Leave a comment


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?

How to&Answers:

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
  '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
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.