Hi,
I need some help to modify this code I got from this link:
http://www.mrexcel.com/forum/excel-questions/167756-inventory-fifo-lifo-average-cost.html
I only needed the average cost section, so I extracted that only. However, I want to modify the code such that I could calculate the average cost based on the inventory item in order of the date.
<tbody>
</tbody>
The codes are below:
On the sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Count > 1 Then Exit Sub
If Not IsNumeric(.Value) Then Exit Sub
If Not Intersect(.Cells(1, 1), Range("e:g")) Is Nothing And _
.Row > 6 Then AVR_COST
End With
End Sub
Module:
Sub AVR_COST()
Dim a, i As Long, Bal As Double, Debit As Double
Dim AVcost As Double
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
End With
With Sheets("AVR COST")
a = .Range("e7", .Cells(.Rows.Count, "g").End(xlUp)).Resize(, 3).Value
.Range("i7", .Cells(.Rows.Count, "i").End(xlUp)).ClearContents
ReDim Preserve a(1 To UBound(a, 1), 1 To 4)
For i = LBound(a, 1) To UBound(a, 1)
If a(i, 2) > 0 Then
Bal = Bal + a(i, 2)
Debit = Debit + a(i, 1) * a(i, 2)
AVcost = Debit / Bal
ElseIf a(i, 3) > 0 Then
a(i, 4) = AVcost
Debit = Debit - a(i, 3) * AVcost
Bal = Bal - a(i, 3)
End If
Next
.Range("i7").Resize(UBound(a, 1)) = Application.Index(a, 0, 4)
Erase a
End With
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
Thanks a million.
I need some help to modify this code I got from this link:
http://www.mrexcel.com/forum/excel-questions/167756-inventory-fifo-lifo-average-cost.html
I only needed the average cost section, so I extracted that only. However, I want to modify the code such that I could calculate the average cost based on the inventory item in order of the date.
Quantity | Cost | ||||||||
Product | DATE | UNIT PRICE | IN | OUT | BALANCE | Unit Price | DEBIT | CREDIT | BALANCE |
1 | 01-Sep-05 | 10.00 | 100 | 100 | 1,000.00 | - | 1,000.00 | ||
1 | 12-Sep-05 | 20.00 | 300 | 400 | 6,000.00 | - | 7,000.00 | ||
2 | 12-Sep-05 | 25.00 | 170 | 570 | 4,250.00 | - | 11,250.00 | ||
1 | 12-Sep-05 | 50 | 520 | 19.74 | - | 986.84 | 10,263.16 | ||
2 | 23-Sep-05 | 70 | 450 | - | - | 10,263.16 | |||
2 | 27-Sep-05 | 30.00 | 700 | 1150 | 21,000.00 | - | 31,263.16 | ||
3 | 29-Sep-05 | 15.00 | 450 | 1600 | 6,750.00 | - | 38,013.16 | ||
3 | 29-Sep-05 | 250 | 1350 | - | - | 38,013.16 | |||
1 | 02-Oct-05 | 25.00 | 320 | 1670 | 8,000.00 | - | 46,013.16 | ||
2 | 03-Oct-05 | 500 | 1170 | - | - | 46,013.16 | |||
3 | 04-Oct-05 | 10 | 1160 | - | - | 46,013.16 | |||
2 | 5.00 | 400 | 1560 | 2,000.00 | - | 48,013.16 | |||
1 | 20 | 1540 | 15.64 | - | 312.77 | 47,700.39 | |||
3 | 50.00 | 100 | 1640 | 5,000.00 | - | 52,700.39 | |||
1 | 50 | 1590 | 19.50 | - | 974.97 | 51,725.41 | |||
2 | 1590 | - | - | 51,725.41 |
<tbody>
</tbody>
The codes are below:
On the sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Count > 1 Then Exit Sub
If Not IsNumeric(.Value) Then Exit Sub
If Not Intersect(.Cells(1, 1), Range("e:g")) Is Nothing And _
.Row > 6 Then AVR_COST
End With
End Sub
Module:
Sub AVR_COST()
Dim a, i As Long, Bal As Double, Debit As Double
Dim AVcost As Double
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
End With
With Sheets("AVR COST")
a = .Range("e7", .Cells(.Rows.Count, "g").End(xlUp)).Resize(, 3).Value
.Range("i7", .Cells(.Rows.Count, "i").End(xlUp)).ClearContents
ReDim Preserve a(1 To UBound(a, 1), 1 To 4)
For i = LBound(a, 1) To UBound(a, 1)
If a(i, 2) > 0 Then
Bal = Bal + a(i, 2)
Debit = Debit + a(i, 1) * a(i, 2)
AVcost = Debit / Bal
ElseIf a(i, 3) > 0 Then
a(i, 4) = AVcost
Debit = Debit - a(i, 3) * AVcost
Bal = Bal - a(i, 3)
End If
Next
.Range("i7").Resize(UBound(a, 1)) = Application.Index(a, 0, 4)
Erase a
End With
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
Thanks a million.