LIFO / FIFO Function Help

Dogz

New Member
Joined
Oct 20, 2004
Messages
3
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
 

Some videos you may like

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
Joined
Jul 18, 2003
Messages
4,494
Hi,

you Cant write to > 1 cell using a function, but how about this:
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
sReply = sReply & ";Total=£" & dCostTot
FIFO = sReply
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
sReply = sReply & ";Total=£" & dCostTot
LIFO = sReply
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
Joined
Jul 18, 2003
Messages
4,494
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
sReply = sReply & Delimiter & "Total=£" & dCostTot
FIFO = sReply
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
sReply = sReply & Delimiter & "Total=£" & dCostTot
LIFO = sReply
End Function
 

Excelanil

Board Regular
Joined
Feb 24, 2010
Messages
96
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
sReply = sReply & Delimiter & "Total=£" & dCostTot
FIFO = sReply
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
sReply = sReply & Delimiter & "Total=£" & dCostTot
LIFO = sReply
End Function
 

Watch MrExcel Video

Forum statistics

Threads
1,118,799
Messages
5,574,380
Members
412,589
Latest member
ArtBOM
Top