FIFO vs. LIFO Calculations using Visual Basic Modules

fifo logo
msofficeshare logo

Requirement: Visual Basic Knowledge and Programming Logics

File to download:  FIFO-LIFO Allocation.xlsm

Related article: Different Looping Mechanisms in Excel VBA

 

First In First Out (FIFO) and Last In First Out (LIFO) calculations are the integral part of an Accounting System.  Neither calculation will affect the life to date (LTD) allocation.  However, the choice of either FIFO or LIFO will affect the periodic recognization of profit or loss.  It all comes down to the timing difference of profit recognition but its impact can be huge for company's bottom line.

 

Most sophicated accounting software will do the calculation of such allocations once the accounting methodology (FIFO or LIFO) is chosen.   However, for small business owners without high-end accounting software or system, the attached Excel file can be handy.  In addition, such allocation, especially the FIFO calculation, can also be used for many other purposes.  For example, I once created an MS Access file with similar Visual Basic (VB) modules to do such calculation for profit recognition of many individual portfolio which consists of many debt securities with numerous transactions.  It is a critical part of tax calculations.  I used the same logic and created VB modules in the downloadable MS Excel file.

 

There are two main VB modules in the Excel file.  The first module (SortData) is to copy and paste the transactions into a temporary worksheet and sort them either by FIFO or LIFO methodology according to the user's choice.

Sub SortData()
    Dim PurchaseLastCell As Integer, SalesLastCell As Integer
    Dim AllocChoice As Integer
    
    Sheets("Summary").Select
    Range("SummaryFirstCell:E2000").Select
    Selection.ClearContents
    
    Range("SummaryFirstCell").Select
        
    If Range("AllocType").Value = "FIFO Allocation" Then
        AllocChoice = 1     'FIFO
    Else
        AllocChoice = 2     'LIFO
    End If
    
    Sheets("Sort").Select
    Columns("A:L").Select
    Selection.ClearContents
    Sheets("Purchase").Select       'Copy Purchase Data to "Sort" worksheet for later sorting
    Columns("A:D").Select
    Selection.Copy
    Sheets("Sort").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    Sheets("Sales").Select          'Copy Sales Data to "Sort" worksheet for later sorting
    Columns("A:D").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sort").Select
    Range("G1").Select
    ActiveSheet.Paste
    
    Range("A1048576").End(xlUp).Select
    PurchaseLastCell = ActiveCell.Row
    
    Range("G1048576").End(xlUp).Select
    SalesLastCell = ActiveCell.Row
        
    'Sort Purchase Data by 1. Inventory, 2. Purchase Date, and 3. Purchase Unit.  The reason why sorted by the Purchase Unit is because there may be multiple
    'purchase in the same day.  Since there is no time input for the Purchase Date, so arbitrarily sorted by the Purchase Unit.
    Columns("A:D").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Sort").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sort").Sort.SortFields.Add Key:=Range("A2:A" & PurchaseLastCell), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sort").Sort.SortFields.Add Key:=Range("B2:B" & PurchaseLastCell), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sort").Sort.SortFields.Add Key:=Range("C2:C" & PurchaseLastCell), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sort").Sort
        .SetRange Range("A1:D" & PurchaseLastCell)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'Sort Purchase Data by 1. Inventory, 2. Sales Date, and 3. Sold Unit.  The reason why sorted by the Sold Unit is because there may be multiple
    'sales in the same day.  Since there is no time input for the Sales Date, so arbitrarily sorted by the Sold Unit.
    Columns("G:J").Select
    ActiveWorkbook.Worksheets("Sort").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sort").Sort.SortFields.Add Key:=Range("G2:G" & SalesLastCell), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    If AllocChoice = 1 Then     'FIFO
        ActiveWorkbook.Worksheets("Sort").Sort.SortFields.Add Key:=Range("H2:H" & SalesLastCell), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Else                        'LIFO
        ActiveWorkbook.Worksheets("Sort").Sort.SortFields.Add Key:=Range("H2:H" & SalesLastCell), _
            SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    End If
    
    ActiveWorkbook.Worksheets("Sort").Sort.SortFields.Add Key:=Range("I2:I" & SalesLastCell), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sort").Sort
        .SetRange Range("G1:J" & SalesLastCell)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("A1").Select
End Sub


Sub Allocation()
    Dim PurchaseLastCell As Integer, SalesLastCell As Integer
    Dim p As Integer, s As Integer, cnt As Integer
    Dim Prev_p As Integer, Prev_s As Integer
    Dim Prev_PItem As Variant, Prev_SItem As Variant
    Dim PRecord As Integer, SRecord As Integer
    Dim PInventory As Variant, PDate As Variant, PUnit As Variant, PCost As Variant     'Purchase Array
    Dim SInventory As Variant, SDate As Variant, SUnit As Variant, SPrice As Variant       'Sales Array
    Dim Remain_PUnit As Integer, Remain_SUnit As Integer
    Dim Unit_Alloc As Integer
    Dim Profit As Currency, Summary_Profit As Currency
    Dim Summary_PUnit As Long, Summary_SUnit As Long
    Dim ErrorMsg As Integer
    
    ActiveWorkbook.Worksheets("Allocation").Select     'Clear the history
    Range("A2:K30000").Select
    Selection.ClearContents
    
    ActiveWorkbook.Worksheets("Sort").Select
    
    Range("A1048576").End(xlUp).Select
    PurchaseLastCell = ActiveCell.Row
    
    Range("G1048576").End(xlUp).Select
    SalesLastCell = ActiveCell.Row
    
    PInventory = Range("A2:A" & PurchaseLastCell).Value
    PDate = Range("B2:B" & PurchaseLastCell).Value
    PUnit = Range("C2:C" & PurchaseLastCell).Value
    PCost = Range("D2:D" & PurchaseLastCell).Value
    
    SInventory = Range("G2:G" & SalesLastCell).Value
    SDate = Range("H2:H" & SalesLastCell).Value
    SUnit = Range("I2:I" & SalesLastCell).Value
    SPrice = Range("J2:J" & SalesLastCell).Value
    
    ActiveWorkbook.Worksheets("Allocation").Select
    Range("A2").Select
    
    'Initialize variables
    p = 1
    s = 1
    Prev_p = 0
    Prev_s = 0
    Prev_PItem = PInventory(1, 1)
    Prev_SItem = SInventory(1, 1)
    Summary_Profit = 0
    Summary_PUnit = 0
    Summary_SUnit = 0
    Do While p < PurchaseLastCell
'        Debug.Print p, PInventory(p, 1), Prev_PItem, s, SInventory(s, 1), Prev_SItem
        
        Do While (SInventory(s, 1) = Prev_SItem) And (SInventory(s, 1) = PInventory(p, 1))
            On Error GoTo ErrorHandler
            
            If p <> Prev_p Then
                Summary_PUnit = Summary_PUnit + PUnit(p, 1)
            End If
            
'            Debug.Print p, PInventory(p, 1), Prev_PItem, s, SInventory(s, 1), Prev_SItem
        
            If p <> Prev_p Then
                ActiveCell.Value = PInventory(p, 1)     'Column A, Inventory
                
                ActiveCell.Offset(0, 1).Select          'Column B, Purchase Date
                ActiveCell.Value = PDate(p, 1)
                
                ActiveCell.Offset(0, 1).Select          'Column C, Unit Purchased
                ActiveCell.Value = PUnit(p, 1)
                
                ActiveCell.Offset(0, 1).Select          'Column D, Unit Cost
                ActiveCell.Value = PCost(p, 1)
            Else
                ActiveCell.Offset(0, 3).Select
            End If
                        
            If SUnit(s, 1) > 0 Then
                ActiveCell.Offset(0, 1).Select          'Column E, Sales Date
                ActiveCell.Value = SDate(s, 1)
                
                ActiveCell.Offset(0, 1).Select          'Column F, Unit Sold or Unit Remained
                ActiveCell.Value = SUnit(s, 1)
                
                ActiveCell.Offset(0, 1).Select          'Column G, Unit Price
                ActiveCell.Value = SPrice(s, 1)
            End If
            
            Prev_p = p
            Prev_s = s
            
            If PUnit(p, 1) >= SUnit(s, 1) Then
                Unit_Alloc = SUnit(s, 1)
                PUnit(p, 1) = PUnit(p, 1) - SUnit(s, 1)
                SUnit(s, 1) = 0
                Profit = Unit_Alloc * (SPrice(s, 1) - PCost(p, 1))
                
                If PUnit(p, 1) = SUnit(s, 1) Then
                    p = p + 1
                End If
                s = s + 1
            Else
                Unit_Alloc = PUnit(p, 1)
                SUnit(s, 1) = SUnit(s, 1) - PUnit(p, 1)
                PUnit(p, 1) = 0
                Profit = Unit_Alloc * (SPrice(s, 1) - PCost(p, 1))
                p = p + 1
            End If
                        
            If Unit_Alloc > 0 Then
                ActiveCell.Offset(0, 1).Select                      'Column H, Unit Allocated
                ActiveCell.Value = Unit_Alloc
                
                ActiveCell.Offset(0, 1).Select                      'Column I, Profit
                ActiveCell.Value = Profit
                                
                ActiveCell.Offset(1, -8).Select
            End If
            
            Summary_Profit = Summary_Profit + Profit
            Summary_SUnit = Summary_SUnit + Unit_Alloc
            
            Prev_PItem = PInventory(Prev_p, 1)
            Prev_SItem = SInventory(Prev_s, 1)
            
            If (PInventory(p, 1) <> Prev_PItem) And (SUnit(s, 1) > 0) Then
                ErrorMsg = MsgBox("The number of total Sales Unit of " & Prev_PItem & " is larger than the number of total Purchase Unit of " & Prev_PItem & ".  Please check your inputs.", vbOKOnly)
            End If
            If ErrorMsg = 1 Then
                Exit Sub
            End If
        Loop
        
        Prev_p = p
        Prev_s = s
        
        p = p + 1
                
        If PInventory(p, 1) = Prev_PItem Then
            Summary_PUnit = Summary_PUnit + PUnit(p, 1)
        
            ActiveCell.Value = PInventory(p, 1)     'Column A, Inventory
            
            ActiveCell.Offset(0, 1).Select          'Column B, Purchase Date
            ActiveCell.Value = PDate(p, 1)
            
            ActiveCell.Offset(0, 1).Select          'Column C, Unit Purchased
            ActiveCell.Value = PUnit(p, 1)
            
            ActiveCell.Offset(0, 1).Select          'Column D, Unit Cost
            ActiveCell.Value = PCost(p, 1)
            
            ActiveCell.Offset(1, -3).Select
        End If
                        
        Prev_PItem = PInventory(Prev_p, 1)
        Prev_SItem = SInventory(Prev_s, 1)
        
        'Populate the Summary
        If PInventory(p, 1) <> Prev_PItem Then
            ActiveWorkbook.Worksheets("Summary").Select
            ActiveCell.Value = PInventory(Prev_p - 1, 1)
            ActiveCell.Offset(0, 1).Select
            ActiveCell.Value = Summary_PUnit
            ActiveCell.Offset(0, 1).Select
            ActiveCell.Value = Summary_SUnit
            ActiveCell.Offset(0, 1).Select
            ActiveCell.Value = Summary_Profit
            ActiveCell.Offset(0, 1).Select
            ActiveCell.Value = Summary_PUnit - Summary_SUnit
            ActiveCell.Offset(1, -4).Select
            
            'Re-initialize variable for next inventory item
            Summary_PUnit = 0
            Summary_SUnit = 0
            Summary_Profit = 0
            ActiveWorkbook.Worksheets("Allocation").Select
        End If
    Loop
    
ErrorHandler:
    Do While p < PurchaseLastCell - 1
        Prev_p = p
        
        p = p + 1
        
        If PInventory(p, 1) = Prev_PItem Then
            Summary_PUnit = Summary_PUnit + PUnit(p, 1)
            
            ActiveCell.Value = PInventory(p, 1)     'Column A, Inventory
            
            ActiveCell.Offset(0, 1).Select          'Column B, Purchase Date
            ActiveCell.Value = PDate(p, 1)
            
            ActiveCell.Offset(0, 1).Select          'Column C, Unit Purchased
            ActiveCell.Value = PUnit(p, 1)
            
            ActiveCell.Offset(0, 1).Select          'Column D, Unit Cost
            ActiveCell.Value = PCost(p, 1)
            
            ActiveCell.Offset(1, -3).Select
        End If
        
        Prev_PItem = PInventory(Prev_p, 1)
    Loop
    If SUnit(Prev_s, 1) > 0 Then
        On Error GoTo 0
        ErrorMsg = MsgBox("The number of total Sales Unit of " & Prev_PItem & " is larger than the number of total Purchase Unit of " & Prev_PItem & ".  Please check your inputs.", vbOKOnly)
    End If
    If ErrorMsg = 1 Then
        Exit Sub
    End If
    ActiveWorkbook.Worksheets("Summary").Select
    ActiveCell.Value = PInventory(Prev_p - 1, 1)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Summary_PUnit
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Summary_SUnit
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Summary_Profit
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Summary_PUnit - Summary_SUnit
End Sub

Sub MainProgram()
    Call SortData
    Call Allocation
End Sub

There are a few points to be mentioned for the Excel model:

Users must "enable" the file so the VB modules can perform.
Users need to input their own data in the "Purchase" or "Sales" worksheets.  It is okay to leave blank rows or input in any order the users want.  The VB modue will sort the data automatically.  However, users should not insert any column.
Users must make the choice of FIFO or LIFO calculation in the "Summary" worksheet,   Afterwards, please click the "Go !" button to initiate the calculations.
After the calculations, if users want to calculate the periodic recognition of profit or loss (e.g. 3Q2014), please use the data on the "Allocation" worksheet and use filters, pivot tables, or any other ways to further analyze the data.
The module will check if the total sales amount is larger than the total purchase amount of an inventory item.  If this happens, it's likely to be a user input error.  The module will prompt the user with an error message.  The users can correct the data and re-run the file by clicking the "Go !" button in the "Summary" worksheet.
If a user decides to use this file, I highly recommend to protect some of the worksheets with password to avoid accidental modifications.

The second module (Allocation) is the core of the calculations.  It creates 2 sets of arrays (Purchase and Sales).  Each array will go through a WHILE loop to allocate.  The two WHILE loops are not separate entities.  Instead, the two loops must intertwine with eah other to make such allocation works.  The first WHILE LOOP loops through each Purchase transaction and the second WHILE loop allocates the Sales units to each Purchase transaction until the sales units exhaust the Purchase units.  Then the Sales transaction moves to allocating to next Purchase transaction.  Please review the VB modules to see how it works.  

The main module tells Excel the sequence of the modules to be executed.