Calculate Cost Basis of Inventory

I need a macro to calculate the cost basis of the inventory. ( Field F3 and
F4 in Sheet1)


Please refer to attached sheet.
Sheet 2 shows Purchase and Sold data
Sheet 1 summarize the purchase and sold and need the currently Inventory Cost basis( F3 and F4).


Logic for Calculation:

First In First Out

Bought 1000 ItemA on 10/2/2008 for $2000
Bought 500 ItemA on 10/10/2008 for $1050

Since I sold 400 ItemA on 10/15/2008 and 100 ItemA on 10/20/2008…
that’s a total of 500 ItemA.
These 500 ItemA would come out of 1000 Apple purchase on 10/2/008 (FIFO)

So i now have 500 ItemA left>>>>>>>> $1000 ( =500*$2)
and 2nd lot 500 ItemA left>>>>>>>> $1050

So the answer would be F3= $1000+$1050=$2050

-------------------------------------------------------------------

Similar logic for ItemBs

Bought 100 ItemB on 10/2/2008 for $50
Bought 200 ItemB on 10/3/2008 for $110

Since I sold 50 ItemB on 10/15/2008 ...
these 50 ItemB would come out of 100 ItemB purchase on 10/2/008

So i now have 50 ItemB left $ 25 ( = 50*.5)
2nd lot 200 ItemB left $ 110

So the answer would be F4=$110+$25= $135



Please help and if you have question's let me know.


Riz Momin

Hi

Using your example file as the basis for structure etc.

1) Create a new Class module, called Class1 (this is the default) and enter the code

Public item As String
Public qty As Long
Public costtot As Double
Public costeach As Double
Public datee As Date

2) Enter the code below into a general module

Sub aaa()
  Application.ScreenUpdating = False
  Dim nodupes As New Collection
  
  Sheets("sheet2").Activate
  Range("A3:F" & Cells(Rows.Count, 1).End(xlUp).Row).Sort key1:=Range("C3"), order1:=xlAscending, key2:=Range("A3"), order1:=xlAscending
  cntr = 1
  For Each ce In Range("C3:C9")
    Select Case ce.Offset(0, -1).Value
      Case "Bought"
        Set thing = New Class1
        thing.datee = ce.Offset(0, -2)
        thing.item = ce.Value
        thing.qty = ce.Offset(0, 1).Value
        thing.costtot = ce.Offset(0, 2).Value
        thing.costeach = ce.Offset(0, 3).Value
        nodupes.Add item:=thing, key:=CStr(cntr)
        cntr = cntr + 1
      Case "Sold"
        workqty = ce.Offset(0, 1).Value
        For i = 1 To cntr - 1
          If nodupes(i).item = ce.Value Then
            If nodupes(i).qty > workqty Then
              nodupes(i).qty = nodupes(i).qty - workqty
              workqty = workqty - workqty
            ElseIf nodupes(i).qty > 0 Then
              workqty = workqty - nodupes(i).qty
              nodupes(i).qty = 0
            
            End If
          End If
        
        Next i
    End Select
  Next ce
  
  Range("I:M").ClearContents
  
  For i = 1 To nodupes.Count
    outrow = Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).Row
    Cells(outrow, "I").Value = nodupes(i).item
    Cells(outrow, "J").Value = nodupes(i).qty
    Cells(outrow, "K").Value = nodupes(i).costeach
  Next i
  
  lastrow = Cells(Rows.Count, "I").End(xlUp).Row
  
  Sheets("Sheet1").Activate
  Range("F3").Formula = "=SUMPRODUCT(--(Sheet2!$I$2:$I$" & lastrow & "=Sheet1!A3),(Sheet2!$J$2:$J$" & lastrow & "),(Sheet2!$K$2:$K$" & lastrow & "))"
  Range("F3").AutoFill Destination:=Range("F3:F" & Cells(Rows.Count, 1).End(xlUp).Row)
  Application.ScreenUpdating = True
End Sub

There is some output on sheet2 columns I-K that is used in the new sumproduct formulas.

HTH

rylo

Thank you so much for the help...

Imagine I have Items with Qty with 3 decimal point like in Stocks..
Bought 500.974 Stock...

Please show me which part of the code needs to edited to accomodate these...



Once again thank you for yoru help...

Riz Momin

Riz

in the class module change the line

Public qty As Long

to

Public qty As single

or

Public qty As double

rylo

Thank you so much for your help...works great..
Will inform you if needed any further help on the same macro

This will save me tons of time...

Riz Momin

I thought i would be able to implement the macro in my original sheet which is hereby attached (Sample2)

I am having some difficulty.

In Sample2 worksheet, Brokerage sheet has all transaction.

i have created CostAve sheet in the same format as Sheet2 of Sample1 worksheet.

The calculated cost basis in need to go is in ShareCalc sheet of Sample2 column I..

Please see if you help me accomplish...


Help greatly appreciated...

Thank you,

Riz Momin