Fifo Method Of Stock Valuation

[sujittalukde]

Also posted at http://www.ozgrid.com/forum/showthread.php?t=71862 but not geeting any reply So posting here.

have a file where I want to make a report which will put the stocks having positive balances along with their prices and values.

Stocks are to be valued on FIFO (First in first out) method ie when the stocks are sold it means it were sold from the first lot bought and so on.



Reporting is required for Shares Held For eg. for Stock A, Buy qtn is (50+50+100+<sell>+100) and sell qtn is 100 So total balance is Buy Qtn 300 - sell Qtn 100 = 200 Sell Qtn 100 will out of first 50 & then next 50 (First in so first out) balance held in hand is out of last two Qtn 100 purchases. The prices are corresponding to these two lots of 100 stocks.

Reporting will be for Stock held (lotwise) See Sheet 2 of the file attached.
Basis of price will be fixed ie no formula etc and corresponding to those lots.

Actually these data are copied from web qwery so formula etc are not required. For cost purpose, price and Total correponding the balnce qtn lot are relevant

In case more clarification required, do let me know. I will try to make them clear.

FIFO.xls
	A	B	C	D	E	F	G
1	Stock	Date	Action	Qty.	Rate	Total
2	A	25-Nov-04	Buy	50	70.3	3,546.70
3	A	20-Jul-05	Buy	50	66	3,330.85
4	A	01-Sep-05	Buy	100	82	8,275.97
5	A	23-Sep-05	Sell	100	76.5	7,579.12
6	A	17-Oct-05	Buy	100	73.8	7,448.38
7	B	03-Jan-05	Buy	200	125.49	25,325.16
8	B	12-Jan-05	Sell	200	98.5	19,522.39
9	BA	05-Sep-06	Sell	300	143	42,485.23	Qtn balance is negative so ignore this stock in reporting
10	BC	21-Dec-04	Buy	20	284.7	5,745.33
11	BC	12-Jan-05	Sell	20	248.6	4,927.18
12	C	21-Dec-04	Buy	300	15.3	4,631.40	Red font means buy sell matched
13	C	12-Jan-05	Sell	300	17.7	5,262.12
14	C	17-Jan-05	Buy	200	18.35	3,703.08
15	C	03-Mar-06	Buy	97	25.55	2,508.38	yellow background means these are in balance
16	C	26-Apr-06	Buy	103	24.05	2,507.69	and should be reported
17	C	05-Dec-06	Buy	100	30.8	3,111.91
18	C	08-Mar-07	Buy	100	32.95	3,327.18
19	D	15-Jan-07	Buy	100	128.5	12,974.24
20	E	08-Mar-07	Buy	100	64.65	6,527.36
21	HH	31-May-07	Buy	100	62.5	6,310.48
22	ID	07-Dec-04	Buy	70	50.85	3,591.59
23	ID	12-Jan-05	Sell	60	68.65	4,081.87
24	IDF	30-Dec-04	Buy	10	107.25	1,100.85
25	IDF	12-Jul-05	Sell	17	112.8	1,888.13	Qtn balance is negative so ignore this stock in reporting
Sheet1

 

[sujittalukde]

Purchase of "A" = 50+50+100+100 (DAtewise) so if the first sell is 70 this means it has come from first 50 lot and balance 20 from second 50 lot. Total balnace will be then 50+50+100-70+100=230 (comprises 30 from second 50 lot, 100 from full 100 Lot (third purchase), finally, 100 from next 100 purchase lot)

You can ask any number of question i wont mind as I know this type of problems are very tricky and with out clearing doubts correct code cannot be written.

 

[jindon]

Ok
So when it is sold, no need to consider selling price? just an inventory, not a p/l ?

 

[sujittalukde]

no selling price need not be considered as because all this data I copy from online so no formula etc are needed. Only the balances in hand (lotwise) and rates and Total should be considered.

The logic to generate the report by the code could be thus:

1. The code will count the balances for each item.
2. Then it will search for lots for those balances Here the code has to match the sell qtn with the purchase qtn and adjust the sell qtn with the purchases made first ie those purchases made first will go out first
3. Then it will pick values for those balance quantities for rates and total.

In this process, for items whose balances will come to negative ie only sell qtn found and no purchase, the code will not report the same.

Please note that these steps are for your guidance only You have to make adjustments for Exceution of code as I am not aware of the steps that how the code will follow the steps.

 

[jindon]

try this
if any bugs, post the details of erro(s) and I will reply tomorrow.

Sub test()
Dim a, i As Long, ii As Long, iii As Long, w(), x, y, z, n As Long
a = Sheets("Sheet1").Range("a1").CurrentRegion.Resize(,5).Value
With CreateObject("Scripting.Dictionary")
     .CompareMode = vbTextCompare
     For i = 2 To UBound(a,1)
          If Not dic.exists(a(i,1)) Then
               ReDim w(1 To 2, 1 To 1)
               For ii = 1 To 2 : w(ii,1) = a(i, ii + 3) : Next
               If a(i,3) = "Sell" Then w(1,1) = "Ignored"
               .add a(i,1), w
          Else
               w = .item(a(i,1))
               If w(1,1) <> "Ignored" Then
                    If a(i,3) = "Buy" Then
                         ReDim Preserve w(1 To 2, 1 To UBound(w,2) + 1)
                         z = UBound(w,2)
                         For ii = 1 To 2 : w(ii, z) = a(i,ii + 3) : Next
                    Else
                         With Application.WorksheetFunction
                              If .Sum(.Index(w, 1, 0)) - a(i,4) < 0 Then
                                   w(3,1) = "Ignored" : GoTo Here
                              End If
                         End With
                         For iii = 1 To UBound(w,2)
                              If w(iii, 1) >= a(i, 4) Then
                                  w(iii,1) = w(iii,1) - a(i,4)
                                  If w(iii,1) > 0 Then Exit For
                              Else
                                  a(i, 4) = a(i,4) - w(iii, 1) : w(iii,1) = 0
                              End If
                         Next
                    End If
               End If
Here:
               .item(a(i,1)) = w
          End If
     Next
     x = .keys : y = .items : Erase a
     For i = 0 To UBound(y)
          If y(i)(1,1) = "Ignored" Then .remove(x(i))
     Next
     x = .keys : y = .items
End With
With Sheets("Sheet2").Range("a3")
     For i = 0 To UBound(y)
          For ii = 1 To UBound(y(i),2)
               If y(i)(1,ii) <> 0 Then
                    .Offset(n).Value = x(i)
                    .Offset(n,1).Value = y(i)(1,ii)
                    .Offset(n,2).Value = y(i)(2,ii)
                    n = n + 1
               End If
          Next
     Next
End With
End Sub

 

[sujittalukde]

Thanks for the code i tried it but one error is coming When I run the code the following line showing error

    If a(i,3) = "Sell Then w(1,1) = "Ignored"

 

[jindon]

Thanks for the code i tried it but one error is coming When I run the code the following line showing error

    If a(i,3) = "Sell Then w(1,1) = "Ignored"

Missed "

    If a(i,3) = "Sell" Then w(1,1) = "Ignored"

Previous code has been edited.

 

[sujittalukde]

Thanks for the reply Now error is coming on this

If Not dic.exists(a(i, 1)) Then

which is the 7th line of your code. Error message is "Run time error 424 Oject required."

 

[Krishnakumar]

remove the dic from the line

 

[veyselemre]

Hi,
I am not knowing more english.
I apologize.

Sub Test()
'http://www.mrexcel.com/board2/viewtopic.php?t=280040
'jindon
Dim a, i As Long, ii As Long, iii As Long, w(), x, y, z, n As Long
a = Sheets("Sheet1").Range("a1").CurrentRegion.Resize(, 5).Value
With CreateObject("Scripting.Dictionary")
     .CompareMode = vbTextCompare
     For i = 2 To UBound(a, 1)
          If Not .exists(a(i, 1)) Then
               ReDim w(1 To 2, 1 To 1)
               For ii = 1 To 2: w(ii, 1) = a(i, ii + 3): Next
               If a(i, 3) = "Sell" Then w(1, 1) = "Ignored"
               .Add a(i, 1), w
          Else
               w = .Item(a(i, 1))
               If w(1, 1) <> "Ignored" Then
                    If a(i, 3) = "Buy" Then
                         ReDim Preserve w(1 To 2, 1 To UBound(w, 2) + 1)
                         z = UBound(w, 2)
                         For ii = 1 To 2: w(ii, z) = a(i, ii + 3): Next
                    Else
                         With Application.WorksheetFunction
                              If .Sum(.Index(w, 1, 0)) - a(i, 4) < 0 Then
                                   w(1, 1) = "Ignored": GoTo Here
                              End If
                         End With
                         For iii = 1 To UBound(w, 2)
                              If w(1, iii) >= a(i, 4) Then
                                  w(1, iii) = w(1, iii) - a(i, 4)
                                  If w(1, iii) = 0 Then Exit For
                              Else
                                  a(i, 4) = a(i, 4) - w(1, iii): w(1, iii) = 0
                              End If
                         Next
                    End If
               End If
Here:
               .Item(a(i, 1)) = w
          End If
     Next
     x = .keys: y = .items: Erase a
     For i = 0 To UBound(y)
          If y(i)(1, 1) = "Ignored" Then .Remove (x(i))
     Next
     x = .keys: y = .items
End With
With Sheets("Sheet2").Range("a3")
     For i = 0 To UBound(y)
          For ii = 1 To UBound(y(i), 2)
               If y(i)(1, ii) <> 0 Then
                    .Offset(n).Value = x(i)
                    .Offset(n, 1).Value = y(i)(1, ii)
                    .Offset(n, 2).Value = y(i)(2, ii)
                    n = n + 1
               End If
          Next
     Next
End With
End Sub

 

[sujittalukde]

This code is made i the right director. However it is not copying the dates and the Total coumn. Can this be modified?