# LIFO / FIFO Function Help

#### Dogz

##### New Member
Guys,

I really need some help.

I am trying to produce a function to calcualte LIFO & FIFO based on the following spreadsheet :
Book2.xls
BCDEFG
3TransactionProductUnitsBoughtUnitCost
41A1010
52B2020
63C3030
74A4011
85B5022
96C6035
107D70100
118A8012
129B9025
13
14
15Fifo(A,100)10@1040@1150@12=1140
16
17Lifo(A,100)80@1220@11=1180
Sheet1

Any help will be gratefully received.

Cheers

Dave

### Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Hi,

Code:
``````Option Explicit

Function FIFO(ByVal Product As String, _
ByVal Units As Long, _
ByVal DataRange As Range) As String
Dim iCol As Integer
Dim lRowFr As Long, lRowTo As Long
Dim lRow As Long, lRowEnd As Long, lBought As Long
Dim sReply As String, sCur As String
Dim dCost As Double, dCostTot As Double
Dim WS As Worksheet

sReply = "FIFO(" & Product & "," & Units & ")"
Set WS = Sheets(DataRange.Parent.Name)
lRowFr = DataRange.Row
lRowTo = DataRange.Rows.Count + lRowFr - 1
iCol = DataRange.Column

For lRow = lRowFr To lRowTo
sCur = WS.Cells(lRow, iCol).Text
If sCur = Product Then
lBought = Val(WS.Cells(lRow, iCol + 1).Value)
Units = Units - lBought
If Units< 0 Then lBought = lBought + Units
dCost = Val(WS.Cells(lRow, iCol + 2).Value)
dCostTot = dCostTot + (lBought * dCost)
sReply = sReply & ";" & lBought & " @ £" & dCost
If Units<= 0 Then Exit For
End If
Next lRow
End Function
Function LIFO(ByVal Product As String, _
ByVal Units As Long, _
ByVal DataRange As Range) As String
Dim iCol As Integer
Dim lRowFr As Long, lRowTo As Long
Dim lRow As Long, lRowEnd As Long, lBought As Long
Dim sReply As String, sCur As String
Dim dCost As Double, dCostTot As Double
Dim WS As Worksheet

sReply = "LIFO(" & Product & "," & Units & ")"
Set WS = Sheets(DataRange.Parent.Name)
lRowFr = DataRange.Row
lRowTo = DataRange.Rows.Count + lRowFr - 1
iCol = DataRange.Column

For lRow = lRowTo To lRowFr Step -1
sCur = WS.Cells(lRow, iCol).Text
If sCur = Product Then
lBought = Val(WS.Cells(lRow, iCol + 1).Value)
Units = Units - lBought
If Units< 0 Then lBought = lBought + Units
dCost = Val(WS.Cells(lRow, iCol + 2).Value)
dCostTot = dCostTot + (lBought * dCost)
sReply = sReply & ";" & lBought & " @ £" & dCost
If Units<= 0 Then Exit For
End If
Next lRow
End Function``````

FIFO & LIFO functions will each return the results into a single cell, with elements separated by a semicolon.

You can then use data / text to columns to separate

Example of use:
Book1
ABCDE
1TransactionProductUnits BoughtUnit Cost
21A1010
32B2020
43C3030
54A4011
65B5022
76C6035
87D70100
98A8012
109B9025
11
12
13FIFO(A,100);10 @ 10;40 @ 11;50 @ 12;Total=1140
14
15LIFO(A,100);80 @ 12;20 @ 11;Total=1180
16
Sheet1

Formula in A13 is =FIFO("A",100,B2:C10)
Formula in A15 is =LIFO("A",100,B2:C10)

This version allows for an optional delimiter (default semicolon):
Code:
``````Option Explicit

Function FIFO(ByVal Product As String, _
ByVal Units As Long, _
ByVal DataRange As Range, _
Optional Delimiter As String = ";") As String
Dim iCol As Integer
Dim lRowFr As Long, lRowTo As Long
Dim lRow As Long, lRowEnd As Long, lBought As Long
Dim sReply As String, sCur As String
Dim dCost As Double, dCostTot As Double
Dim WS As Worksheet

sReply = "FIFO(" & Product & "," & Units & "," & DataRange.Address(False, False) & ")"
Set WS = Sheets(DataRange.Parent.Name)
lRowFr = DataRange.Row
lRowTo = DataRange.Rows.Count + lRowFr - 1
iCol = DataRange.Column

For lRow = lRowFr To lRowTo
sCur = WS.Cells(lRow, iCol).Text
If sCur = Product Then
lBought = Val(WS.Cells(lRow, iCol + 1).Value)
Units = Units - lBought
If Units < 0 Then lBought = lBought + Units
dCost = Val(WS.Cells(lRow, iCol + 2).Value)
dCostTot = dCostTot + (lBought * dCost)
sReply = sReply & Delimiter & lBought & " @ £" & dCost
If Units <= 0 Then Exit For
End If
Next lRow
End Function
Function LIFO(ByVal Product As String, _
ByVal Units As Long, _
ByVal DataRange As Range, _
Optional Delimiter As String = ";") As String
Dim iCol As Integer
Dim lRowFr As Long, lRowTo As Long
Dim lRow As Long, lRowEnd As Long, lBought As Long
Dim sReply As String, sCur As String
Dim dCost As Double, dCostTot As Double
Dim WS As Worksheet

sReply = "LIFO(" & Product & "," & Units & "," & DataRange.Address(False, False) & ")"
Set WS = Sheets(DataRange.Parent.Name)
lRowFr = DataRange.Row
lRowTo = DataRange.Rows.Count + lRowFr - 1
iCol = DataRange.Column

For lRow = lRowTo To lRowFr Step -1
sCur = WS.Cells(lRow, iCol).Text
If sCur = Product Then
lBought = Val(WS.Cells(lRow, iCol + 1).Value)
Units = Units - lBought
If Units < 0 Then lBought = lBought + Units
dCost = Val(WS.Cells(lRow, iCol + 2).Value)
dCostTot = dCostTot + (lBought * dCost)
sReply = sReply & Delimiter & lBought & " @ £" & dCost
If Units <= 0 Then Exit For
End If
Next lRow
End Function``````

Hi,

Are you or anyone on this Forum open to answering a question or two about your VBA Code (see below) and its use?

Thanks.

This version allows for an optional delimiter (default semicolon):
Code:
``````Option Explicit

Function FIFO(ByVal Product As String, _
ByVal Units As Long, _
ByVal DataRange As Range, _
Optional Delimiter As String = ";") As String
Dim iCol As Integer
Dim lRowFr As Long, lRowTo As Long
Dim lRow As Long, lRowEnd As Long, lBought As Long
Dim sReply As String, sCur As String
Dim dCost As Double, dCostTot As Double
Dim WS As Worksheet

sReply = "FIFO(" & Product & "," & Units & "," & DataRange.Address(False, False) & ")"
Set WS = Sheets(DataRange.Parent.Name)
lRowFr = DataRange.Row
lRowTo = DataRange.Rows.Count + lRowFr - 1
iCol = DataRange.Column

For lRow = lRowFr To lRowTo
sCur = WS.Cells(lRow, iCol).Text
If sCur = Product Then
lBought = Val(WS.Cells(lRow, iCol + 1).Value)
Units = Units - lBought
If Units < 0 Then lBought = lBought + Units
dCost = Val(WS.Cells(lRow, iCol + 2).Value)
dCostTot = dCostTot + (lBought * dCost)
sReply = sReply & Delimiter & lBought & " @ £" & dCost
If Units <= 0 Then Exit For
End If
Next lRow
End Function
Function LIFO(ByVal Product As String, _
ByVal Units As Long, _
ByVal DataRange As Range, _
Optional Delimiter As String = ";") As String
Dim iCol As Integer
Dim lRowFr As Long, lRowTo As Long
Dim lRow As Long, lRowEnd As Long, lBought As Long
Dim sReply As String, sCur As String
Dim dCost As Double, dCostTot As Double
Dim WS As Worksheet

sReply = "LIFO(" & Product & "," & Units & "," & DataRange.Address(False, False) & ")"
Set WS = Sheets(DataRange.Parent.Name)
lRowFr = DataRange.Row
lRowTo = DataRange.Rows.Count + lRowFr - 1
iCol = DataRange.Column

For lRow = lRowTo To lRowFr Step -1
sCur = WS.Cells(lRow, iCol).Text
If sCur = Product Then
lBought = Val(WS.Cells(lRow, iCol + 1).Value)
Units = Units - lBought
If Units < 0 Then lBought = lBought + Units
dCost = Val(WS.Cells(lRow, iCol + 2).Value)
dCostTot = dCostTot + (lBought * dCost)
sReply = sReply & Delimiter & lBought & " @ £" & dCost
If Units <= 0 Then Exit For
End If
Next lRow
End Function``````

Replies
10
Views
690
Replies
5
Views
399
Replies
0
Views
680
Replies
2
Views
199
Replies
0
Views
445

1,214,749
Messages
6,121,309
Members
449,023
Latest member
MLPM

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

### Which adblocker are you using?

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

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