Snasui Excel Forum

Code: Select all

Sub AVR_COST()
    Dim a, i  As Long, Bal As Double, Debit As Double
    Dim AVcost As Double, q As Long
    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
                q = q + a(i, 2)
                Bal = Bal + a(i, 1) * a(i, 2)
            ElseIf a(i, 3) > 0 Then
                q = q - a(i, 3)
                Bal = Bal - (AVcost * a(i, 3))
            End If
            AVcost = Bal / q
            a(i, 4) = AVcost
        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