+ Reply to Thread
Results 1 to 2 of 2

Myrna Larson, locate??

  1. #1
    mike allen
    Guest

    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?

    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



  2. #2
    mike allen
    Guest

    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" <[email protected]> wrote in message
    news:[email protected]...
    > 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
    >




+ Reply to Thread

Thread Information

Users Browsing this Thread

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

Bookmarks

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