Calculate FIFO based multi scrip Profit and Loss

Question

I am struggling with my vba code which calculates Realized and Unrealized profit in share trade. I believe that this utility will be of great help to all small traders who cannot afford costly soultions. My code calculates certain figures correctly while falters in others.

Setup: The trade file consists of 6 columns

scrip   b_s    date        qty  rate        Current price
ABC1    buy    12-09-2023   20  4609.69     4752.95
ABC1    sale   20-09-2023   20  4337.645    4752.95
ABC2    buy    13-09-2023   75  689.9513333 907.05
ABC2    buy    10-11-2023   65  885         907.05

The macro calculates the pre_qtr profit, qtr_profit, Unrealized profit in ColJ, K, L on FIFO basis. The qtr period is defined in the macro as contant for time being though later it will be input based. The sale quantity for a scrip will be <= total buy quantity. The sale date is used to decide in which column the result will go. The first sale will be setoff from first available quantity. The unsold quantity of a stock will be used for calculating Unrealized profit. The logic to be used is remaining quantity * market price minus the the total cost of remaining quantity.
In my excel sheet I have given the correct figures in separate column by manually calculating them.

Issue faced: The macro calculates correctly if the total sale quantity = total buy quantity of such scrips. It errs if there is only buy and no sale of the scrip. It also errs if there are multi sale instances for a scrip. The unrealized profit is calculated wrongly.

I have attached my code here also and have attached my excel sheet with sample data.

where am I going wrong and what is the solution?

https://docs.google.com/spreadsheets/d/1DxcO78dgdz0AvdDgNDt4U0C2-_AQ7a0eMaUbkFjDwfU/edit?usp=drivesdk

    Sub CalculateFIFOProfit1()

        Const QTR_START_DATE As Date = #10/1/2023#  ' DD-MM-YYYY format
        Const QTR_END_DATE As Date = #12/31/2023# ' DD-MM-YYYY format
    
        Dim currentRow As Long
        Dim totalBought As Long
        Dim totalRemaining As Long ' Track remaining quantity from past buys
        Dim boughtPrice As Double
        Dim soldPrice As Double
        Dim preQtrProfit As Double
        Dim thisQtrProfit As Double
        Dim unrealizedProfit As Double
        Dim currentScrip As String
        Dim lastRow As Long
        Dim marketPrice As Double ' Add this variable to store current market price
        Dim lastBoughtPrice As Double ' Add this variable to store latest buy price
    
        currentRow = 2 ' Assuming headers in row 1
        lastRow = 2 ' Track last row for each scrip
        totalBought = 0
        totalRemaining = 0
        boughtPrice = 0
        preQtrProfit = 0
        thisQtrProfit = 0
        unrealizedProfit = 0
        currentScrip = ""
        lastBoughtPrice = 0 ' Initialize last buy price
        Dim lrow As Long
        lrow = Cells(Rows.Count, 1).End(xlUp).Row
        'Do While Cells(currentRow, 1).Value <> ""
        'Do While currentRow <= Cells(Rows.Count, 1).End(xlUp).Row 'Do While currentRow <= 173 '<= Cells(Rows.Count, 1).End(xlUp).Row
        Do While currentRow <= lrow
            If Cells(currentRow, 1).Value <> currentScrip Then
                ' New scrip, output profits for previous scrip
                
                If lastRow > 0 Then
                    Cells(lastRow, 10).Value = preQtrProfit
                    Cells(lastRow, 11).Value = thisQtrProfit
                    marketPrice = Cells(lastRow, 6).Value ' Retrieve market price from ColF
                    Cells(lastRow, 12).Value = unrealizedProfit + marketPrice * totalRemaining - lastBoughtPrice * totalRemaining ' Corrected unrealized profit calculation
                End If
                currentScrip = Cells(currentRow, 1).Value
                lastRow = currentRow ' Reset last row for new scrip
                totalBought = 0
                totalRemaining = 0
                boughtPrice = 0
                preQtrProfit = 0
                thisQtrProfit = 0
                unrealizedProfit = 0
                lastBoughtPrice = 0 ' Reset last buy price for new scrip
            End If
    
            If Cells(currentRow, 2).Value = "buy" Then
                totalBought = totalBought + Cells(currentRow, 4).Value ' Quantity in ColD
                boughtPrice = boughtPrice + Cells(currentRow, 5).Value * Cells(currentRow, 4).Value ' Rate in ColE
                totalRemaining = totalRemaining + Cells(currentRow, 4).Value
                lastBoughtPrice1 = Cells(currentRow, 5).Value ' Update last buy price
                ' Update lastBoughtPrice calculation
                'lastBoughtPrice = (totalBought * boughtPrice - Cells(currentRow, 4).Value * Cells(currentRow, 5).Value) / (totalBought - Cells(currentRow, 4).Value)
                If totalBought - Cells(currentRow, 4).Value <> 0 Then
                lastBoughtPrice = boughtPrice
                'lastBoughtPrice = (totalBought * boughtPrice - Cells(currentRow, 4).Value * Cells(currentRow, 5).Value) / (totalBought - Cells(currentRow, 4).Value)
                Else
                ' Handle the case when totalBought - sale quantity is zero
                lastBoughtPrice1 = Cells(currentRow, 5).Value  ' Set lastBoughtPrice to zero or any value you deem appropriate
    End If
    
            ElseIf Cells(currentRow, 2).Value = "sale" Then
                totalSold = totalSold + Cells(currentRow, 4).Value ' Quantity in ColD
                If totalSold = 0 Then unrealizedProfit = (Cells(currentRow, 6).Value * totalBought) - boughtPrice
                ' Compare dates in DD-MM-YYYY format
                If Cells(currentRow, 3).Value <= QTR_START_DATE Then ' Date in ColC
                    ' Pre-quarter sale
                    Dim remainingBeforeSale As Double ' Stores remaining quantity before this sale
                    remainingBeforeSale = totalRemaining
                    If remainingBeforeSale >= Cells(currentRow, 4).Value Then ' Enough pre-quarter stocks
                        preQtrProfit = preQtrProfit + (Cells(currentRow, 5).Value * Cells(currentRow, 4).Value) - (boughtPrice / totalBought) * Cells(currentRow, 4).Value
                        boughtPrice = boughtPrice - boughtPrice * Cells(currentRow, 4).Value / totalBought ' Adjust bought price for FIFO
                        totalRemaining = totalRemaining - Cells(currentRow, 4).Value
                    Else ' Not enough pre-quarter stocks, use remaining and adjust bought price proportionally
                        totalRemaining = 0
                        preQtrProfit = preQtrProfit + (Cells(currentRow, 5).Value * remainingBeforeSale) - (boughtPrice * remainingBeforeSale / totalBought)
                        boughtPrice = boughtPrice - boughtPrice * remainingBeforeSale / totalBought
                    End If
                ElseIf Cells(currentRow, 3).Value <= QTR_END_DATE Then ' Date in ColC
                    ' This-quarter sale
                    thisQtrProfit = thisQtrProfit + (Cells(currentRow, 5).Value * Cells(currentRow, 4).Value) - (boughtPrice / totalBought) * totalSold '(boughtPrice * Cells(currentRow, 4).Value / totalBought)
                    boughtPrice = boughtPrice - boughtPrice * Cells(currentRow, 4).Value / totalBought ' Adjust bought price for FIFO
                    totalRemaining = totalRemaining - Cells(currentRow, 4).Value
                Else ' Post-quarter sale
                    unrealizedProfit = unrealizedProfit - (boughtPrice * Cells(currentRow, 4).Value / totalBought) ' Adjust unrealized profit
                    boughtPrice = boughtPrice - boughtPrice * Cells(currentRow, 4).Value / totalBought
                    totalRemaining = totalRemaining - Cells(currentRow, 4).Value
                End If
            End If
            currentRow = currentRow + 1
        Loop
        If lrow > 0 Then
            Cells(lrow, 10).Value = preQtrProfit
            Cells(lrow, 11).Value = thisQtrProfit
            marketPrice = Cells(lrow, 6).Value
            Cells(lrow, 12).Value = unrealizedProfit + marketPrice * totalRemaining - lastBoughtPrice '* totalRemaining
        End If
    End Sub

Answer 1

There are some issues in your code including the handling of the FIFO logic.

I have updated the code, try it:

Sub CalculateFIFOProfit1()

    Const QTR_START_DATE As Date = #10/1/2023#  ' DD-MM-YYYY format
    Const QTR_END_DATE As Date = #12/31/2023# ' DD-MM-YYYY format

    Dim currentRow As Long
    Dim totalBought As Double
    Dim totalRemaining As Double
    Dim boughtPrice As Double
    Dim preQtrProfit As Double
    Dim thisQtrProfit As Double
    Dim unrealizedProfit As Double
    Dim currentScrip As String
    Dim lastRow As Long
    Dim marketPrice As Double
    Dim lastBoughtPrice As Double

    currentRow = 2 ' Assuming headers in row 1
    lastRow = 2 ' Track last row for each scrip
    totalBought = 0
    totalRemaining = 0
    boughtPrice = 0
    preQtrProfit = 0
    thisQtrProfit = 0
    unrealizedProfit = 0
    currentScrip = ""
    lastBoughtPrice = 0 ' Initialize last buy price

    Dim lrow As Long
    lrow = Cells(Rows.Count, 1).End(xlUp).Row

    Do While currentRow <= lrow
        If Cells(currentRow, 1).Value <> currentScrip Then
            ' New scrip, output profits for previous scrip
            If lastRow > 0 Then
                Cells(lastRow, 10).Value = preQtrProfit
                Cells(lastRow, 11).Value = thisQtrProfit
                marketPrice = Cells(lastRow, 6).Value
                Cells(lastRow, 12).Value = unrealizedProfit + marketPrice * totalRemaining - lastBoughtPrice * totalRemaining
            End If
            currentScrip = Cells(currentRow, 1).Value
            lastRow = currentRow ' Reset last row for new scrip
            totalBought = 0
            totalRemaining = 0
            boughtPrice = 0
            preQtrProfit = 0
            thisQtrProfit = 0
            unrealizedProfit = 0
            lastBoughtPrice = 0 ' Reset last buy price for new scrip
        End If

        If Cells(currentRow, 2).Value = "buy" Then
            totalBought = totalBought + Cells(currentRow, 4).Value
            boughtPrice = boughtPrice + Cells(currentRow, 5).Value * Cells(currentRow, 4).Value
            totalRemaining = totalRemaining + Cells(currentRow, 4).Value
            lastBoughtPrice = Cells(currentRow, 5).Value ' Update last buy price
        ElseIf Cells(currentRow, 2).Value = "sale" Then
            If totalRemaining > 0 Then
                ' Sale logic
                Dim saleQuantity As Double
                saleQuantity = Cells(currentRow, 4).Value
                If saleQuantity <= totalRemaining Then
                    ' Enough remaining stocks for the sale
                    preQtrProfit = preQtrProfit + (Cells(currentRow, 5).Value * saleQuantity) - (boughtPrice / totalBought) * saleQuantity
                    boughtPrice = boughtPrice - boughtPrice * saleQuantity / totalBought
                    totalRemaining = totalRemaining - saleQuantity
                Else
                    ' Not enough remaining stocks, adjust profits and remaining quantity
                    preQtrProfit = preQtrProfit + (Cells(currentRow, 5).Value * totalRemaining) - (boughtPrice * totalRemaining / totalBought)
                    boughtPrice = 0 ' No remaining stocks
                    totalRemaining = 0
                End If
            End If
            ' Sale period logic
            If Cells(currentRow, 3).Value <= QTR_START_DATE Then
                ' Pre-quarter sale
                thisQtrProfit = thisQtrProfit + 0 ' No impact on this quarter profit
            ElseIf Cells(currentRow, 3).Value <= QTR_END_DATE Then
                ' This-quarter sale
                thisQtrProfit = thisQtrProfit + (Cells(currentRow, 5).Value * Cells(currentRow, 4).Value) - (boughtPrice / totalBought) * Cells(currentRow, 4).Value
                boughtPrice = boughtPrice - boughtPrice * Cells(currentRow, 4).Value / totalBought
                totalRemaining = totalRemaining - Cells(currentRow, 4).Value
            Else
                ' Post-quarter sale
                unrealizedProfit = unrealizedProfit - (boughtPrice * Cells(currentRow, 4).Value / totalBought)
                boughtPrice = 0 ' No remaining stocks
                totalRemaining = 0
            End If
        End If
        currentRow = currentRow + 1
    Loop

    ' Output for the last scrip
    If lastRow > 0 Then
        Cells(lastRow, 10).Value = preQtrProfit
        Cells(lastRow, 11).Value = thisQtrProfit
        marketPrice = Cells(lastRow, 6).Value
        Cells(lastRow, 12).Value = unrealizedProfit + marketPrice * totalRemaining - lastBoughtPrice * totalRemaining
    End If

End Sub