Option Explicit
Function myRate(pv As Double, n As Long, bal As Double, k As Long, Optional r As Double = 0.1)
Const nLoop As Long = 200
Const maxDbl As Double = (2 ^ 1023 - 2 ^ (1023 - 53)) * 2
Dim c As Double, i As Long
Dim f As Double, f0 As Double, r0 As Double, df As Double
Dim minF As Double, absF As Double, minR As Double
' determine r (periodic rate) for c = fv[k]/pv
' given only pv (loan amt), n (#periods to amortize loan to zero),
' fv[k] (bal after k periods), and k (#payments made).
' note: pmt is not given. thus:
' 0 = (1-c)*(1+r)^n - (1+r)^k + c
On Error GoTo badVal
If n <= 0 Or k <= 0 Or n < k Then GoTo badVal
If r < -1 Then GoTo badVal
c = Abs(bal / pv)
On Error GoTo done
minF = maxDbl
f0 = 0
r0 = r
minR = r0
For i = 1 To nLoop
f = (1 - c) * (1 + r) ^ n - (1 + r) ^ k + c
If f = 0 Then minF = f: minR = r: GoTo noErr
absF = Abs(f)
If absF < minF Then
minF = absF: minR = r
ElseIf absF = minF Then
If r < minR Then minR = r
End If
If f = f0 Then Exit For
If i = nLoop Then Exit For
df = n * (1 - c) * (1 + r) ^ (n - 1) - k * (1 + r) ^ (k - 1)
' newton-raphson method
r = r0 - f / df
If r = r0 Or r < -1 Then Exit For
r0 = r
f0 = f
Next
done:
' arbitrarily "close to zero"
If Abs(minF) < 0.00005 Then GoTo noErr
myRate = CVErr(xlErrNum)
Exit Function
badVal:
myRate = CVErr(xlErrValue)
Exit Function
noErr:
myRate = minR
End Function
