# Myrna Larson, locate??

1. ## Myrna Larson, locate??

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?

"CouponAfter" calculated?
Thanks, Mike Allen

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
Loop
..NumCoupons = DateDiff("m", PrevCoup, .maturity) \ MonthsBetweenCoupons
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

2. ## Re: Myrna Larson, locate??

never mind, i think i figured it out (there were two different names being
used for same vaiable, i think). thanks, mike allen

"mike allen" <mikeallen77@charter.net> wrote in message
news:uM4TbCuuFHA.3316@TK2MSFTNGP10.phx.gbl...
> 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?
>
> "CouponAfter" calculated?
> Thanks, Mike Allen
>
> 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
>

There are currently 1 users browsing this thread. (0 members and 1 guests)

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1