LIFO / FIFO Function Help

[Dogz]

Guys,

I really need some help.

I am trying to produce a function to calcualte LIFO & FIFO based on the following spreadsheet :

Book2.xls
	B	C	D	E	F	G
3	Transaction	Product	UnitsBought	UnitCost
4	1	A	10	10
5	2	B	20	20
6	3	C	30	30
7	4	A	40	11
8	5	B	50	22
9	6	C	60	35
10	7	D	70	100
11	8	A	80	12
12	9	B	90	25
13
14
15	Fifo(A,100)		10@10	40@11	50@12	=1140
16
17	Lifo(A,100)		80@12	20@11		=1180
Sheet1

Any help will be gratefully received.

Cheers

Dave

 

[al_b_cnu]

Hi,

you Cant write to > 1 cell using a function, but how about this:

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
	A	B	C	D	E
1	Transaction	Product	Units Bought	Unit Cost
2	1	A	10	10
3	2	B	20	20
4	3	C	30	30
5	4	A	40	11
6	5	B	50	22
7	6	C	60	35
8	7	D	70	100
9	8	A	80	12
10	9	B	90	25
11
12
13	FIFO(A,100);10 @ 10;40 @ 11;50 @ 12;Total=1140
14
15	LIFO(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]

This version allows for an optional delimiter (default semicolon):

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]

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):

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