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

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" wrote in message
...
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