# 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

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

#### al_b_cnu

##### Well-known Member
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)

#### al_b_cnu

##### Well-known Member
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``````

#### Excelanil

##### Board Regular
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
3
Views
119
Replies
2
Views
525
Replies
11
Views
280
Replies
0
Views
132
Replies
7
Views
136