M
mike allen
Myrna was kind enough to provide some serious code for me some time back. I
am having trouble with it and would like to ask her about it. Hopefully she
will see this message, but if not, does anyone know how to reach her?
Main question about this code is where/how is "CouponBefore" and
"CouponAfter" calculated?
Thanks, Mike Allen
Myrna's code reads:
Option Explicit
Type BondInfoType
'supplied parameters
Settlement As Date
maturity As Date
Rate As Double
Price As Double
redemption As Double
frequency As Long
basis As Long
'calculated parameters
coupon As Double
NumCoupons As Long
FraxPeriod As Double
AccrInt As Double
End Type
Function BondYield(Settlement As Date, maturity As Date, _
Rate As Double, Price As Double, redemption As Double, _
frequency As Long, Optional basis As Long = 0) As Variant
Dim BondInfo As BondInfoType
Dim Diff As Double
Dim i As Long
Dim MaxYield As Double
Dim MinYield As Double
Dim Msg As String
Dim Yld As Double
Const Accuracy As Double = 0.0001
Const MaxIterations As Long = 200
With BondInfo
..Settlement = Settlement
..maturity = maturity
..Rate = Rate
..Price = Price
..redemption = redemption
..frequency = frequency
..basis = basis
End With
If CheckArguments(BondInfo, Msg) = False Then
BondYield = Msg
Exit Function
End If
CalculateRemainingParameters BondInfo
With BondInfo
If .NumCoupons = 1 Then
Yld = YieldWith1Coupon(BondInfo)
Else
MinYield = -1#
MaxYield = .Rate
If MaxYield = 0 Then MaxYield = 0.1
Do While CalculatedPrice(BondInfo, MaxYield) > .Price
MaxYield = MaxYield * 2
Loop
Yld = 0.5 * (MinYield + MaxYield)
For i = 1 To MaxIterations
Diff = CalculatedPrice(BondInfo, Yld) - .Price
If Abs(Diff) < Accuracy Then Exit For
'if calculated price is greater, correct yield is greater
If Diff > 0 Then MinYield = Yld Else MaxYield = Yld
Yld = 0.5 * (MinYield + MaxYield)
Next i
End If
BondYield = Yld
End With
End Function 'BondYield
Function BondPrice(Settlement As Date, maturity As Date, _
Rate As Double, yield As Double, redemption As Double, _
frequency As Long, Optional basis As Long = 0) As Variant
Dim BondInfo As BondInfoType
Dim Msg As String
With BondInfo
..Settlement = Settlement
..maturity = maturity
..Rate = Rate
..Price = 100 'dummy value for CheckArguments
..redemption = redemption
..frequency = frequency
..basis = basis
End With
If CheckArguments(BondInfo, Msg) = False Then
BondPrice = Msg
Else
CalculateRemainingParameters BondInfo
BondPrice = CalculatedPrice(BondInfo, yield)
End If
End Function 'BondPrice
Private Function CalculatedPrice(BondInfo As BondInfoType, Yld As Double)
Dim coupon As Double
Dim K As Long
Dim n As Long
Dim Price As Double
Dim t As Double
Dim y As Double
With BondInfo
n = .NumCoupons
y = 1 + Yld / .frequency
t = .FraxPeriod 'time to first coupon in periods
coupon = .coupon
'present value of the redemption price
Price = .redemption * (y ^ -(n - 1 + t))
'add present value of the coupons
If coupon > 0 Then
For K = 1 To n
Price = Price + coupon * (y ^ -t) 'Y^(-t) = 1/(Y^t)
t = t + 1
Next K
End If
'subtract accrued interest
Price = Price - .AccrInt
End With
CalculatedPrice = Price
End Function 'CalculatedPrice
Private Sub CalculateRemainingParameters(BondInfo As BondInfoType)
Dim CouponAfter As Long
Dim CouponBefore As Long
Dim DaysSettleToCoupon As Long
Dim CouponPeriodLength As Long 'in days
Dim settle As Long
With BondInfo
..coupon = 100 * .Rate / .frequency
GetCouponDates BondInfo, CouponBefore, CouponAfter
If .basis = 0 Then
CouponPeriodLength = Application.Days360(CouponBefore, CouponAfter)
DaysSettleToCoupon = Application.Days360(.Settlement, CouponAfter)
Else
CouponPeriodLength = CouponAfter - CouponBefore
DaysSettleToCoupon = CouponAfter - .Settlement
End If
..FraxPeriod = DaysSettleToCoupon / CouponPeriodLength
..AccrInt = .coupon * (1 - .FraxPeriod)
End With
End Sub 'CalculateRemainingParameters
Private Function CheckArguments(BondInfo As BondInfoType, _
Msg As String) As Boolean
Dim OK As Boolean
With BondInfo
OK = False
Msg = ""
Do
If .Settlement >= .maturity Then _
Msg = "Settlement date >= maturity date": Exit Do
If .Rate < 0 Then Msg = "Rate < 0": Exit Do
If .Price <= 0 Then Msg = "Purchase price <= 0": Exit Do
If .redemption <= 0 Then Msg = "Redemption price <= 0": Exit Do
Select Case .frequency
Case 1, 2, 3, 4, 6, 12
Case Else
Msg = "Frequency must be 1, 2, 3, 4, 6, or 12"
Exit Do
End Select
Select Case .basis
Case 0, 1
OK = True: Exit Do
Case Else
Msg = "Basis must be 0 or 1": Exit Do
End Select
Loop
End With
CheckArguments = OK
End Function 'CheckArguments
Private Sub GetCouponDates(BondInfo As BondInfoType, _
PrevCoup As Long, NextCoup As Long)
Dim MonthsBetweenCoupons As Integer
With BondInfo
MonthsBetweenCoupons = 12 \ .frequency
PrevCoup = DateSerial(Year(.Settlement) + 1, Month(.maturity),
Day(.maturity))
If PrevCoup > .maturity Then PrevCoup = .maturity
Do While PrevCoup > .Settlement
PrevCoup = DateAdd("m", -MonthsBetweenCoupons, PrevCoup)
Loop
..NumCoupons = DateDiff("m", PrevCoup, .maturity) \ MonthsBetweenCoupons
NextCoup = DateAdd("m", MonthsBetweenCoupons, PrevCoup)
End With
End Sub 'GetCouponDates
Private Function YieldWith1Coupon(BondInfo As BondInfoType) As Double
Dim Cost As Double
Dim Gain As Double
Dim Proceeds As Double
Dim t As Double
With BondInfo
Proceeds = .redemption + .coupon 'receive at maturity
Cost = .Price + .AccrInt 'pay at purchase
Gain = Proceeds / Cost - 1
t = .FraxPeriod / .frequency 'time in years = frax * 1 / freq
End With
YieldWith1Coupon = Gain / t
End Function 'YieldWith1Coupon
am having trouble with it and would like to ask her about it. Hopefully she
will see this message, but if not, does anyone know how to reach her?
Main question about this code is where/how is "CouponBefore" and
"CouponAfter" calculated?
Thanks, Mike Allen
Myrna's code reads:
Option Explicit
Type BondInfoType
'supplied parameters
Settlement As Date
maturity As Date
Rate As Double
Price As Double
redemption As Double
frequency As Long
basis As Long
'calculated parameters
coupon As Double
NumCoupons As Long
FraxPeriod As Double
AccrInt As Double
End Type
Function BondYield(Settlement As Date, maturity As Date, _
Rate As Double, Price As Double, redemption As Double, _
frequency As Long, Optional basis As Long = 0) As Variant
Dim BondInfo As BondInfoType
Dim Diff As Double
Dim i As Long
Dim MaxYield As Double
Dim MinYield As Double
Dim Msg As String
Dim Yld As Double
Const Accuracy As Double = 0.0001
Const MaxIterations As Long = 200
With BondInfo
..Settlement = Settlement
..maturity = maturity
..Rate = Rate
..Price = Price
..redemption = redemption
..frequency = frequency
..basis = basis
End With
If CheckArguments(BondInfo, Msg) = False Then
BondYield = Msg
Exit Function
End If
CalculateRemainingParameters BondInfo
With BondInfo
If .NumCoupons = 1 Then
Yld = YieldWith1Coupon(BondInfo)
Else
MinYield = -1#
MaxYield = .Rate
If MaxYield = 0 Then MaxYield = 0.1
Do While CalculatedPrice(BondInfo, MaxYield) > .Price
MaxYield = MaxYield * 2
Loop
Yld = 0.5 * (MinYield + MaxYield)
For i = 1 To MaxIterations
Diff = CalculatedPrice(BondInfo, Yld) - .Price
If Abs(Diff) < Accuracy Then Exit For
'if calculated price is greater, correct yield is greater
If Diff > 0 Then MinYield = Yld Else MaxYield = Yld
Yld = 0.5 * (MinYield + MaxYield)
Next i
End If
BondYield = Yld
End With
End Function 'BondYield
Function BondPrice(Settlement As Date, maturity As Date, _
Rate As Double, yield As Double, redemption As Double, _
frequency As Long, Optional basis As Long = 0) As Variant
Dim BondInfo As BondInfoType
Dim Msg As String
With BondInfo
..Settlement = Settlement
..maturity = maturity
..Rate = Rate
..Price = 100 'dummy value for CheckArguments
..redemption = redemption
..frequency = frequency
..basis = basis
End With
If CheckArguments(BondInfo, Msg) = False Then
BondPrice = Msg
Else
CalculateRemainingParameters BondInfo
BondPrice = CalculatedPrice(BondInfo, yield)
End If
End Function 'BondPrice
Private Function CalculatedPrice(BondInfo As BondInfoType, Yld As Double)
Dim coupon As Double
Dim K As Long
Dim n As Long
Dim Price As Double
Dim t As Double
Dim y As Double
With BondInfo
n = .NumCoupons
y = 1 + Yld / .frequency
t = .FraxPeriod 'time to first coupon in periods
coupon = .coupon
'present value of the redemption price
Price = .redemption * (y ^ -(n - 1 + t))
'add present value of the coupons
If coupon > 0 Then
For K = 1 To n
Price = Price + coupon * (y ^ -t) 'Y^(-t) = 1/(Y^t)
t = t + 1
Next K
End If
'subtract accrued interest
Price = Price - .AccrInt
End With
CalculatedPrice = Price
End Function 'CalculatedPrice
Private Sub CalculateRemainingParameters(BondInfo As BondInfoType)
Dim CouponAfter As Long
Dim CouponBefore As Long
Dim DaysSettleToCoupon As Long
Dim CouponPeriodLength As Long 'in days
Dim settle As Long
With BondInfo
..coupon = 100 * .Rate / .frequency
GetCouponDates BondInfo, CouponBefore, CouponAfter
If .basis = 0 Then
CouponPeriodLength = Application.Days360(CouponBefore, CouponAfter)
DaysSettleToCoupon = Application.Days360(.Settlement, CouponAfter)
Else
CouponPeriodLength = CouponAfter - CouponBefore
DaysSettleToCoupon = CouponAfter - .Settlement
End If
..FraxPeriod = DaysSettleToCoupon / CouponPeriodLength
..AccrInt = .coupon * (1 - .FraxPeriod)
End With
End Sub 'CalculateRemainingParameters
Private Function CheckArguments(BondInfo As BondInfoType, _
Msg As String) As Boolean
Dim OK As Boolean
With BondInfo
OK = False
Msg = ""
Do
If .Settlement >= .maturity Then _
Msg = "Settlement date >= maturity date": Exit Do
If .Rate < 0 Then Msg = "Rate < 0": Exit Do
If .Price <= 0 Then Msg = "Purchase price <= 0": Exit Do
If .redemption <= 0 Then Msg = "Redemption price <= 0": Exit Do
Select Case .frequency
Case 1, 2, 3, 4, 6, 12
Case Else
Msg = "Frequency must be 1, 2, 3, 4, 6, or 12"
Exit Do
End Select
Select Case .basis
Case 0, 1
OK = True: Exit Do
Case Else
Msg = "Basis must be 0 or 1": Exit Do
End Select
Loop
End With
CheckArguments = OK
End Function 'CheckArguments
Private Sub GetCouponDates(BondInfo As BondInfoType, _
PrevCoup As Long, NextCoup As Long)
Dim MonthsBetweenCoupons As Integer
With BondInfo
MonthsBetweenCoupons = 12 \ .frequency
PrevCoup = DateSerial(Year(.Settlement) + 1, Month(.maturity),
Day(.maturity))
If PrevCoup > .maturity Then PrevCoup = .maturity
Do While PrevCoup > .Settlement
PrevCoup = DateAdd("m", -MonthsBetweenCoupons, PrevCoup)
Loop
..NumCoupons = DateDiff("m", PrevCoup, .maturity) \ MonthsBetweenCoupons
NextCoup = DateAdd("m", MonthsBetweenCoupons, PrevCoup)
End With
End Sub 'GetCouponDates
Private Function YieldWith1Coupon(BondInfo As BondInfoType) As Double
Dim Cost As Double
Dim Gain As Double
Dim Proceeds As Double
Dim t As Double
With BondInfo
Proceeds = .redemption + .coupon 'receive at maturity
Cost = .Price + .AccrInt 'pay at purchase
Gain = Proceeds / Cost - 1
t = .FraxPeriod / .frequency 'time in years = frax * 1 / freq
End With
YieldWith1Coupon = Gain / t
End Function 'YieldWith1Coupon