Excel - UDF to Calculate YTM

Asked By ryguy7272 on 06-Apr-10 02:29 PM
```If I go to this site:
http://www.moneychimp.com/articles/finworks/fmbondytm.htm

Look at the Example:
YTM = 7.37%
The formula seems simple enough, so I tried to write my own function:

Function YieldMaturity(C, Y, n, P, R)

Dim sumall As Double
Dim j As Integer

sumall = 0
For j = 1 To n
sumall = sumall + ((C / (1 + Y) ^ n))
Next j

YieldMaturity = ((sumall + (P / (1 + Y) ^ n)) / R)

End Function

I use these inputs:
Nominal Coupon Rate = 70
Interest = 7%
Bond Price = 925.6
Redemption = 1000
Years = 4

Here is me calling the function:
=YieldMaturity(B7,B8,B11,B9,B10)

I get a result of 93.84%

Can someone please tell me what is wrong with my function? I suspect it is
the summing part.

Thanks!
--
Ryan---

Joe User replied to ryguy7272 on 06-Apr-10 04:18 PM
```[....]

To begin with, that should be ^i instead of ^n.

But I think you fundamentally misunderstand the algorithm.  You are supposed
to derived R.

See the following implementation.  The result closely matches the result of
the MoneyChimp pop-up calculator for the example in the aritcle (price \$950,
par \$1000, interest 7% over 4 years).

I use a binary search algorithm to derive YTM (r).  There are better
algorithms.  I am sure Dana will offer one.

-----
UDF

'c(1 + r)-1 + c(1 + r)-2 + . . . + c(1 + r)-n + B(1 + r)-n = P
'where:
'c = annual coupon payment (in dollars, not a percent)
'n = number of years to maturity
'B = par value
'P = purchase price

Option Explicit

'variable result to allow for #NUM result
Function myYTM(intrate As Double, P As Double, B As Double, n As Integer)
Dim pv As Double, c As Double, r As Double, i As Integer
Dim hi As Double, lo As Double, r0 As Double

On Error GoTo myError
c = B * intrate
hi = 2 * intrate
lo = intrate
r0 = 0
Do
'interatively select r until pv is "close to" zero
r = (hi + lo) / 2
pv = 0
For i = 1 To n
pv = pv + 1 / (1 + r) ^ i
Next i
pv = c * pv + B / (1 + r) ^ n - P
If Abs(pv) < 0.005 Then Exit Do
If r = r0 Then GoTo myError
If pv < 0 Then hi = r Else lo = r
r0 = r
Loop
myYTM = r
Exit Function

myError:
myYTM = CVErr(xlErrNum)
End Function

----- original message -----```
ryguy7272 replied to Joe User on 06-Apr-10 05:45 PM
```That's right to four decimal places, which is fine for me!!  Thanks so much!!!!

--
Ryan---
tompl replied to Joe User on 06-Apr-10 10:25 PM
```Very nicely done!

Tom```
Dana DeLouis replied to Joe User on 06-Apr-10 11:53 PM
```Hi.  Not any better, but it did converge in 6 loops.  :>0
The UL is there in case the solution cycles between two numbers that
do not exactly match)

Sub Testit()
'0.0853
Debug.Print MyYTM(0.07, 1000, 950, 4)
End Sub

Function MyYTM(Y, B, P, n)

Dim r
Dim c
Dim k
Dim z
Dim UL ' Upper Limit safety check

c = B * Y
r = 0.1 'Default Guess

Do While z <> r And UL < 20
z = r
k = 1 + r
r = r - (r * k * (c - B * r + k ^ n * (P * r - c))) / _
(c * k ^ (1 + n) + B * r ^ 2 * n - c * (k + r * n))
UL = UL + 1
Loop

MyYTM = r
End Function

HTH  :>)
Dana DeLouis```
Dana DeLouis replied to Dana DeLouis on 07-Apr-10 10:49 AM
```Just to double check...

Sub Easier()
Dim Cash
Cash = Array(-950, 70, 70, 70, 70 + 1000)
Debug.Print WorksheetFunction.IRR(Cash)
End Sub

' 8.52736277081097E-02```