Create Yield to maturity formula in VBA

S

Spurious

Active Member
Joined
Dec 14, 2010
Messages
439
Hello guys,

I got a question regarding some financial maths:

I want to write a function in VBA that calculates the following:

C: coupon
F: face value
P: price
y: Yield to maturity

P = C/(1+y)^1 + C/(1+y)^2 + C/(1+y)^3 + ... + C/(1+y)^n + F/(1+y)^n

Now let's assume C, F and P are given, I want to obtain y with a VBA tool, what's my play?

I dont want to use regular Excel.

Thanks in advance.
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
Can you give some typical values of P, C, F ... and what about n, how does it get set or determined?
 
Upvote 0
Face value (F) = 1000
Coupon (%) (C) = 8%*F
Current price (P) = 1050
Maturity (n) = 3

Btw, I forgot to mention that:
VERY IMPORTANT!

I want to solve it for y.
 
Last edited:
Upvote 0
Largely untested. I have 4 named cells on the active sheet. The names are Price, FaceValue, CouponRate, and YearsToMaturity. These cells contain the obvious inputs. The Coupon rate can be entered as a % or a decimal value (e.g. 8% = 0.08).
Code: 
]
Sub YieldToMaturity()
Dim F As Double, Cr As Double, Cv As Double, N As Integer, P As Double, Dif As Double
Dim Inc As Double, Ct As Long, YTM As Double, x As Double, curYld As Double
With ActiveSheet
    F = .Range("FaceValue")
    Cr = .Range("CouponRate").Value
    Cv = F * Cr
    P = .Range("Price")
    N = .Range("YearsToMaturity")
    curYld = Cv / P
    Inc = 0.00001
    'First pass trial value for YTM
    Select Case curYld
        Case Is > Cr
        YTM = curYld + Inc
        Do
            Ct = Ct + 1
            x = 1 + YTM
            Dif = P - (Cv * SumIt(N, x) + F / x ^ N)
            YTM = YTM + Inc
        Loop While Ct <= 100000 And Dif < 0
        
        Case Is < Cr
        YTM = curYld - Inc
        Do
            Ct = Ct + 1
            x = 1 + YTM
            Dif = P - (Cv * SumIt(N, x) + F / x ^ N)
            YTM = YTM - Inc
        Loop While Ct <= 100000 And Dif > 0
    End Select
End With
MsgBox "YTM is: " & Round(YTM * 100, 2) & "%" & vbNewLine & "After " & Ct & " iterations"
End Sub

Function SumIt(N As Integer, x As Double) As Double
For k = 1 To N
    SumIt = SumIt + 1 / (x) ^ k
Next k

End Function
The answer I get for the values you posted is YTM = 6.12%
 
Upvote 0
Apologies, in my earlier post I forgot to include the trivial case where the current yield and coupon rate are the same (i.e. Price = FaceValue):
Code: 
Sub YieldToMaturity()
Dim F As Double, Cr As Double, Cv As Double, N As Integer, P As Double, Dif As Double
Dim Inc As Double, Ct As Long, YTM As Double, x As Double, curYld As Double
With ActiveSheet
    F = .Range("FaceValue")
    Cr = .Range("CouponRate").Value
    Cv = F * Cr
    P = .Range("Price")
    N = .Range("YearsToMaturity")
    curYld = Cv / P
    Inc = 0.00001
    'First pass trial value for YTM
    Select Case curYld
        Case Is > Cr
        YTM = curYld + Inc
        Do
            Ct = Ct + 1
            x = 1 + YTM
            Dif = P - (Cv * SumIt(N, x) + F / x ^ N)
            YTM = YTM + Inc
        Loop While Ct <= 100000 And Dif < 0
        
        Case Is < Cr
        YTM = curYld - Inc
        Do
            Ct = Ct + 1
            x = 1 + YTM
            Dif = P - (Cv * SumIt(N, x) + F / x ^ N)
            YTM = YTM - Inc
        Loop While Ct <= 100000 And Dif > 0
        Case Else
            YTM = curYld
    End Select
End With
MsgBox "YTM is: " & Round(YTM * 100, 2) & "%" & vbNewLine & "After " & Ct & " iterations"
End Sub

Function SumIt(N As Integer, x As Double) As Double
For k = 1 To N
    SumIt = SumIt + 1 / (x) ^ k
Next k

End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Golf Skins
Replies
3
Views
297
Fluff
Fluff
gtd526
  • Question
vba Sorting Columns w/ 2 Criteria's
Replies
1
Views
137
gtd526
gtd526
H
  • Question
VBA Speed up Copy and paste
Replies
3
Views
370
skillilea
S
GMC The Macro Man
  • Question
Clear Data without VBA
2
Replies
12
Views
668
mumps
mumps
G
  • Question
Excel VBA Open Word Doc and Save as New Word Doc
Replies
1
Views
111
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,214,991
Messages
6,122,628
Members
449,095
Latest member
bsb1122

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top