FIFO Macro giving different results each time it runs

E

EasyDoesIt

New Member
Joined
Mar 5, 2023
Messages
4
Office Version
  1. 2010
Platform
  1. Windows
Hi,
I would like to ask for some help with a FIFO cost calculator for tax purposes that uses earliest stocks bought first at those prices. No averaging, only real prices paid to be used. I have found a few excel sheets with VBA online and seen a few in here, but none of them tick all the boxes. For example, some only deal with one type of stock / item, others average, others can only keep track of the prices paid in the last two batches bought. So if one buys batches of 30 x 3 at different prices, it cannot use the price of the first batch bought. There is one I found that does all I need, but it is not giving consistent results each time. I have tried to fiddle with variables and redim, but I know almost nothing about this, so cannot tweak it. Even closing excel and the VBA editor does not reset whatever is happening. Each time the COGS get bigger and bigger,

An example of what the macro should do:
So one might buy 50 then another 55, before selling 40. When the 40 is sold, it is costed at the per unit price of the original 50. 10 remains of that 50.
When another 30 is sold, it is costed at 10 (remainder after previous sale) at the price paid for the 50, and the remaining 20 at the price paid for the 55. 35 remain in the second lot bought (on hand), ready for the next sale.
I also need the on hand values of all items at the end, which the sheet is doing correctly.
The code also sorts the purchases into items, then dates, so all of the same item purchases are grouped together. That is happening correctly.
It calculates quantity sold (QTY_out), leftover / on hand (Remaining_Qty) and remaining value of on hand (Remaining_Valuation) correctly.

The only field that is incorrect is column O, COGS (FIFO). To re-run, I delete all the data in the yellow blocks and press the button again. If I look at individual lines, every COGS value is wrong and it increases with each run. I would really appreciate if someone can tell me what is going wrong please. I have put the code in the VBA editor as well as a mini-sheet below. Thank you.

VBA Code: 
Sub FIFO()
'
Dim QtySold() As Long, SKU_TYPE() As String, SalesINV() As String, source() As String, Cost() As Double
Dim i As Integer, t As Integer, pending As Integer, matched As Integer, j As Integer, x As Double
Dim rngA As Range
Dim cell As Range

' www.excel4routine.com
' ZKL 13/04/19
    Application.ScreenUpdating = False


        'if inventory records < 1 row exit sub
        'else add remaining column fill down
        With ActiveSheet
            If .Cells(.Rows.Count, "A").End(xlUp).Row > 2 Then
           
                'Sort Inventory by Pdt,by Date
                'https://trumpexcel.com/sort-data-vba/
                With ActiveSheet.Sort
                    .SortFields.Clear ' to clear prior sort data
                    .SortFields.Add Key:=Range("B1"), Order:=xlAscending
                    .SortFields.Add Key:=Range("A1"), Order:=xlAscending
                    .SetRange Range("mydata")
                    .Header = xlYes
                    .Apply
                End With
           
                .Range("G2:G" & .Cells(.Rows.Count, "C").End(xlUp).Row).Formula = "=C2-F2"
                .Range("H2:H" & .Cells(.Rows.Count, "C").End(xlUp).Row).Formula = "=G2*D2"
                .Range("O2:O" & .Cells(.Rows.Count, "K").End(xlUp).Row).Formula = "=SUMIFs(LOG!F:F,LOG!A:A,K2,LOG!C:C,L2)"
            End If
            
        End With
       

       
       
       
        'Check Availability of stock for those pending insufficient cases

        Set rngA = ActiveSheet.Range("P2:P" & ActiveSheet.Cells(ActiveSheet.Rows.Count, "P").End(xlUp).Row)
       
        t = 0
       
        For Each cell In rngA
            If cell.Value = "Insufficient Stock" Then
               
                If Not WorksheetFunction.SumIf(ActiveSheet.Range("B:B"), ActiveSheet.Range("L" & cell.Row).Value, ActiveSheet.Range("G:G")) < ActiveSheet.Range("M" & cell.Row).Value Then
                    ActiveSheet.Range("N" & cell.Row).Value = ActiveSheet.Range("M" & cell.Row).Value
                    ActiveSheet.Range("P" & cell.Row).ClearContents
                    'Narrow down the range for SKU lookup
                    'goto by find
                    Let endrow = Columns("B:B").Find(What:=ActiveSheet.Range("L" & cell.Row).Value, After:=ActiveSheet.Range("B1"), LookIn:=xlValues, LookAt _
                            :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
                            False, SearchFormat:=False).Row
                    Let startrow = Columns("B:B").Find(What:=ActiveSheet.Range("L" & cell.Row).Value, After:=ActiveSheet.Range("B1"), LookIn:=xlValues, LookAt _
                            :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                            False, SearchFormat:=False).Row
                           
                    x = ActiveSheet.Range("M" & cell.Row).Value
                      
                    'Loop through Inventory
                    For i = startrow To endrow
                                
                        With Range("B" & i)
                               
                            If x <> 0 And .Offset(, 5).Value > 0 Then
                                t = t + 1
                                ReDim Preserve QtySold(t)
                                ReDim Preserve SKU_TYPE(t) 'Range("L" & j).Value
                                ReDim Preserve SalesINV(t) 'Range("K" & j).Value
                                ReDim Preserve source(t)    '.Offset(, 3)
                                ReDim Preserve Cost(t)    '.Offset(, 2)
                                                                  
                                    If .Offset(, 5).Value >= x Then
                                        .Offset(, 4) = .Offset(, 4) + x
                                        QtySold(t) = x
                                        SKU_TYPE(t) = ActiveSheet.Range("L" & cell.Row).Value
                                        SalesINV(t) = ActiveSheet.Range("K" & cell.Row).Value
                                        source(t) = .Offset(, 3)
                                        Cost(t) = .Offset(, 2)
                                        x = 0
                                    Else
                                        SKU_TYPE(t) = ActiveSheet.Range("L" & cell.Row).Value
                                        SalesINV(t) = ActiveSheet.Range("K" & cell.Row).Value
                                        source(t) = .Offset(, 3)
                                        Cost(t) = .Offset(, 2)
                                        QtySold(t) = .Offset(, 5).Value
                                        x = x - .Offset(, 5).Value
                                        .Offset(, 4) = .Offset(, 4) + .Offset(, 5)
                                    End If
                            End If
                                  
                        End With
                       
                    Next i
                   
                End If
            End If
        Next cell
       

    'Do a check for new orders pending to be matched comparing the last row of col M & N
        Let pending = Columns("M:M").Find(What:="*", After:=ActiveSheet.Range("M1"), LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
        False, SearchFormat:=False).Row
       
        Let matched = Columns("N:N").Find(What:="*", After:=ActiveSheet.Range("N1"), LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
        False, SearchFormat:=False).Row
       
       
    'Do a check for availability of remaining inventory b4 going on
    'Loop through sales order .if stock available proceed to match else just 0 and skip to next iteration
        For j = matched + 1 To pending
           
            If WorksheetFunction.SumIf(ActiveSheet.Range("B:B"), ActiveSheet.Range("L" & j).Value, ActiveSheet.Range("G:G")) < ActiveSheet.Range("M" & j).Value Then
                Range("N" & j).Value = 0
                Range("P" & j).Value = "Insufficient Stock" 'Update those outstanding "insufficient stocks" that are just matched to LOG
                GoTo NextIteration:
            Else
                Range("N" & j).Value = Range("M" & j).Value
            End If


        'Narrow down the range for SKU lookup
        'goto by find
            Let endrow = Columns("B:B").Find(What:=ActiveSheet.Range("L" & j).Value, After:=ActiveSheet.Range("B1"), LookIn:=xlValues, LookAt _
                    :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
                    False, SearchFormat:=False).Row
            Let startrow = Columns("B:B").Find(What:=ActiveSheet.Range("L" & j).Value, After:=ActiveSheet.Range("B1"), LookIn:=xlValues, LookAt _
                    :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    False, SearchFormat:=False).Row
                   
            x = ActiveSheet.Range("M" & j).Value

           
            'Loop through Inventory
            For i = startrow To endrow
                        
                With Range("B" & i)
                       
                    If x <> 0 And .Offset(, 5).Value > 0 Then
                           
                        t = t + 1
                        ReDim Preserve QtySold(t)
                        ReDim Preserve SKU_TYPE(t) 'Range("L" & j).Value
                        ReDim Preserve SalesINV(t) 'Range("K" & j).Value
                        ReDim Preserve source(t)    '.Offset(, 3)
                        ReDim Preserve Cost(t)    '.Offset(, 2)
                       
                            If .Offset(, 5).Value >= x Then
                                .Offset(, 4) = .Offset(, 4) + x
                                QtySold(t) = x
                                SKU_TYPE(t) = ActiveSheet.Range("L" & j).Value
                                SalesINV(t) = ActiveSheet.Range("K" & j).Value
                                source(t) = .Offset(, 3)
                                Cost(t) = .Offset(, 2)
                                x = 0
                            Else
                                SKU_TYPE(t) = ActiveSheet.Range("L" & j).Value
                                SalesINV(t) = ActiveSheet.Range("K" & j).Value
                                source(t) = .Offset(, 3)
                                Cost(t) = .Offset(, 2)
                                QtySold(t) = .Offset(, 5).Value
                                x = x - .Offset(, 5).Value
                                .Offset(, 4) = .Offset(, 4) + .Offset(, 5)
                            End If
                   
                    End If
                                              
                End With
               
            Next i
NextIteration:
        Next j
       
        'UPDATE LOG
        On Error Resume Next
        'http://www.cpearson.com/excel/ArraysAndRanges.aspx
        'Could be improved through split function I think....to be explored later
        Dim Destination As Range
       
        Set Destination = LOG.Cells(LOG.Rows.Count, "A").End(xlUp).Offset(1, 0)
        Set Destination = Destination.Resize(UBound(SalesINV), 1)
        Destination.Value = Application.Transpose(SalesINV)
       
        Set Destination = LOG.Cells(LOG.Rows.Count, "B").End(xlUp).Offset(1, 0)
        Set Destination = Destination.Resize(UBound(source), 1)
        Destination.Value = Application.Transpose(source)
       
        Set Destination = LOG.Cells(LOG.Rows.Count, "C").End(xlUp).Offset(1, 0)
        Set Destination = Destination.Resize(UBound(SKU_TYPE), 1)
        Destination.Value = Application.Transpose(SKU_TYPE)
       
        Set Destination = LOG.Cells(LOG.Rows.Count, "D").End(xlUp).Offset(1, 0)
        Set Destination = Destination.Resize(UBound(QtySold), 1)
        Destination.Value = Application.Transpose(QtySold)
       
        Set Destination = LOG.Cells(LOG.Rows.Count, "E").End(xlUp).Offset(1, 0)
        Set Destination = Destination.Resize(UBound(Cost), 1)
        Destination.Value = Application.Transpose(Cost)
       
        LOG.Range("F2:F" & LOG.Cells(LOG.Rows.Count, "E").End(xlUp).Row).Formula = "=E2*D2"
        '''''End If
       
        With ActiveSheet
            .Range("Orders").Value = .Range("Orders").Value
            .Range("MyData").Value = .Range("MyData").Value
        End With
        DoEvents

    Application.ScreenUpdating = True
End Sub

FIFO_Inventory2Cogs.xlsm
ABCDEFGHIJKLMNOPQRS
1DateSKUQty_INPriceInv/POQTY_OUTRemaining_QtyRemaining_ValuationSales InvoiceSKUQTY ORDERMATCHEDCOGS (FIFO)REMARKS
21/01/2016A1001.20PO11000-Invoice 1A42042025108
31/02/2016A1001.30PO21000-Invoice 2A28028027534
41/03/2016A1001.20PO31000-Invoice 3B50050016400
51/04/2016A2001.25PO42000-Invoice 4A60060010319.5
61/05/2016A2001.33PO52000-Invoice 5C25025016380
71/06/2016A1001.40PO61000-Invoice 6A3003007609.5
81/07/2016A1501.44PO71500-Invoice 7B30030013640
91/01/2017A2001.46PO82000-Invoice 8B40040012300
101/02/2017A2001.45PO92000-Invoice 9C55210
111/03/2017A2001.50PO102000-Invoice 10B30030013380
121/04/2017A2001.55PO1150150232.50Invoice 11B33145.8
131/05/2017A2501.60PO12250400.00Invoice 12B44194.4
141/06/2017A1501.55PO13Invoice 13B5
151/07/2017A1501.55PO14Invoice 14B6
161/08/2017A1501.50PO15Invoice 15B7
171/09/2017A1501.48PO16
181/10/2017A1501.38PO17
191/11/2017A1501.40PO18
201/12/2017A1501.50PO19
216/06/2018A3003PO35
221/08/2016B2002.00PO20
231/09/2016B2002.10PO21
241/10/2016B2002.00PO22
251/11/2016B2002.00PO23
261/12/2016B2002.00PO24
271/01/2018B2002.10PO25
281/02/2018B2002.20PO26
291/03/2018B2002.00PO27
301/04/2018B2002.50PO28
311/05/2018B2002.00PO29
321/06/2018B2002.20PO30
331/06/2018B6003.00PPP999
342/06/2018C1003.1PO31
353/06/2018C1003.2PO32
364/06/2018C1003PO33
375/06/2018C1003PO34
Inventory
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Sort by date Sort by votes
Hi EasyDoesIt and Welcome to the Board! The only place that I can see that references the "O" column is this...
Code: 
.Range("O2:O" & .Cells(.Rows.Count, "K").End(xlUp).Row).Formula = "=SUMIFs(LOG!F:F,LOG!A:A,K2,LOG!C:C,L2)"
Is "LOG" the name of the sheet with the data? Everything else references the active sheet which seems to be "Inventory' (bottom left of pic). HTH. Dave
 
Upvote 0
Hi Dave, Thanks for your reply.

There is another sheet called LOG, where he logs what the programme has done, for example what matching between transactions, at what cost. I also searched the code for "O and O: and Cost. I would assume he's calculating COST for the O column.

This line is used a few times:
Cost(t) = .Offset(, 2)
Could he be reaching 'O' with the offset word? Still, as I understand, that puts the value into 'cost', but 'cost' still has to be sent to the sheet O. I cannot see where that is done.

I also searched for * since he'd have to multiply the matched with the price in D. I know extremely little about programming, so just guessing here... none of the ones I found looked right. It should be D * N (or maybe M, if it's all matched to one purchase).

The one line I thought was important was this:
ActiveSheet.Range("N" & cell.Row).Value = ActiveSheet.Range("M" & cell.Row).Value

M = the quanity matched. So that times the price would give the COGS we're needing. I just cannot find the bit that follows on that though.

It's 11 pm for me. I have to get to bed. I'm hoping you'll have more thoughts. Take care.

Thanks,
Genevieve
 
Upvote 0
EasyDoesIt said:
Hi Dave, Thanks for your reply.

There is another sheet called LOG, where he logs what the programme has done, for example what matching between transactions, at what cost. I also searched the code for "O and O: and Cost. I would assume he's calculating COST for the O column.

This line is used a few times:
Cost(t) = .Offset(, 2)
Could he be reaching 'O' with the offset word? Still, as I understand, that puts the value into 'cost', but 'cost' still has to be sent to the sheet O. I cannot see where that is done.

I also searched for * since he'd have to multiply the matched with the price in D. I know extremely little about programming, so just guessing here... none of the ones I found looked right. It should be D * N (or maybe M, if it's all matched to one purchase).

The one line I thought was important was this:
ActiveSheet.Range("N" & cell.Row).Value = ActiveSheet.Range("M" & cell.Row).Value

M = the quanity matched. So that times the price would give the COGS we're needing. I just cannot find the bit that follows on that though.

It's 11 pm for me. I have to get to bed. I'm hoping you'll have more thoughts. Take care.

Thanks,
Genevieve
Click to expand...
By the way, I have found this same code referenced on this forum in another chat, but it didn't answer my question. I also found another FIFO one, but I don't have access to that excel sheet and the full VBA, so cannot try it out.
 
Upvote 0
Code: 
SUMIFs(LOG!F:F,LOG!A:A,K2,LOG!C:C,L2)
I'm hoping others will correct me if I'm wrong, but my understanding of this formula is that it sums the values of the LOG! "F" rows if the value in LOG! "A" row = K2 of the active sheet AND the value in LOG! "C" row equals the value of "L2" in the active sheet. This makes me thing that the formula should be...
Code: 
SUMIFs(LOG!F:F,LOG!A:A,LOG!K2,LOG!C:C,LOG!L2)
The "O" values are generated by this inserted formula so if the formula is wrong, your "O" values will be wrong. Dave
 
Upvote 0
Hi Dave,
I have not tried changing that line of code yet, but I will investigate that further. When you said that the log data was being used, I thought maybe we should try to clear the data and see what happens. So then I did a few runs and physically deleted the data from the log sheet each time. Consistent results. I recorded a macro that deletes the data (a first for me) and assigned it to a new button, namely 'Clear Data'. If I need to re-run calculations, I clear the data between runs. So then I thought I'd improve on that by clearing the data from the FIFO sub. I put ClearData in as the first line of code. The result was that it had an error 91, object variable or with block variable not set. It broke on this line:

VBA Code: 
'Do a check for new orders pending to be matched comparing the last row of col M & N
        Let pending = Columns("M:M").Find(What:="*", After:=ActiveSheet.Range("M1"), LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
        False, SearchFormat:=False).Row

Then I thought to move the line to the last line in the FIFO sub. That works, but when it's finished running, the Log sheet has focus, so I changed that by printing something in a random cell on the Inventory sheet. It works. So in retrospect, it must be that my cleardata was changing the activesheet, so everything else broke. :) This is the code I used:

Code: 
'Clear away old calculation data
    ClearLog
    'Return focus to Inventory Sheet
    Worksheets("Inventory").Range("I2").Value = 75

Thank you very much for your help. There is more tweaking I will need to do, but for now it is working. I have learnt a few things along the way. You take care.
Cheers,
Genevieve
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Run-Time Error 381
2
Replies
12
Views
200
Micron
M
E
  • Question Question
Function to return array of 10 largest absolute values while maintaining sign
Replies
3
Views
566
eurobonds
E
S
  • Question Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
543
sspatriots
S
B
  • Solved
vba code to give next Sunday date for pasted data
Replies
2
Views
697
bh24524
B
D
  • Solved
Numeric Value returned when Time format returned to User Form TextBox
Replies
3
Views
133
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,224,737
Messages
6,180,653
Members
452,992
Latest member
TokugawaIesuma

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top