Snasui Excel Forum

Code: Select all

Function TOAMORTIZE(Principal As Double, StartDate As Date, EndDate As Date, FromDate As Date, ToDate As Date) As Double
Dim Accumulated As Double ' from assumptions
Dim TotalDays, CalcDays As Integer
Dim PerDay, PerDaySum, Results As Double
Dim EachDayDate() As Date
Dim EachDayValue() As Double
Dim n, i As Integer
PerDay = 0
PerDaySum = 0
Results = 0
ActiveCell.Value = ""
TotalDays = EndDate - StartDate + 1
ReDim EachDayDate(TotalDays)
ReDim EachDayValue(TotalDays)
CalcDays = ToDate - FromDate + 1
PerDay = Application.Round((Principal / TotalDays), 2)
For n = 0 To (TotalDays - 1)
EachDayDate(n) = StartDate + n
EachDayValue(n) = PerDay
PerDaySum = Application.Round((PerDaySum + PerDay), 2)
Next
If PerDaySum > Principal Then
EachDayValue(TotalDays - 1) = EachDayValue(TotalDays - 1) - Application.Round((PerDaySum - Principal), 2)
Else 'If PerDaySum "<" Principal Then
EachDayValue(TotalDays - 1) = PerDay + Application.Round((((PerDaySum - Principal) - (PerDay * i)) * -1), 2)
End If
For n = 0 To TotalDays - 1
If EachDayDate(n) >= FromDate And EachDayDate(n) <= ToDate Then
TOAMORTIZE = TOAMORTIZE + EachDayValue(n)
End If
Next
Erase EachDayDate        ' Erasing the Array
Erase EachDayValue        ' Erasing the Array
End Function

Code: Select all

ActiveCell.Value = ""

Code: Select all

Sub Amortize()
.
.
.
End Sub