Implied Probability Rates Rise in VBA

Use this Excel program to calculate the implied risk-neutral probability that interest rates will rise using a binomial framework.


Download Excel Spreadsheet to Calculate Risk-Neutral Probability that Rates will Rise



The code underlying the procedure is as follows:



Public RateTree() As Double, MMATree() As Double, ZeroTree() As Double
Public CallTree() As Double, PutTree() As Double, InitialRate As Double
Public TimeToExpiration As Double, UpMove As Double, DownMove As Double
Public ProbUp(10000) As Double, TotalYears As Double, PeriodsPerYear As Double
Public i As Integer, j As Integer, Strike As Double, YearsToMaturity As Double
Public OptionPeriods As Double, TotalPeriods As Double, BondPeriods As Double
Public BondValue As Double, k As Integer, EstPrice(10000) As Double

Sub RatesTree()

'Insert Values
    Strike = Range("C5").Value
    TimeToExpiration = Range("C6").Value
    BondValue = Range("C9").Value
    ParValue = Range("C10").Value
    YearsToMaturity = Range("C11").Value
    
    InitialRate = Range("H5").Value
    UpMove = Range("H6").Value
    DownMove = Range("H7").Value
    TotalYears = Range("H8").Value
    PeriodsPerYear = Range("H9").Value
    
    OptionPeriods = Round(PeriodsPerYear * TimeToExpiration, 0) + 1
    BondPeriods = Round(PeriodsPerYear * YearsToMaturity, 0) + 1
    TotalPeriods = Round(PeriodsPerYear * TotalYears, 0)
'

'Sets Up Worksheet
    ReDim RateTree(TotalPeriods, TotalPeriods) As Double
    ReDim MMATree(BondPeriods, BondPeriods) As Double
    ReDim CallTree(OptionPeriods, OptionPeriods) As Double
    ReDim PutTree(OptionPeriods, OptionPeriods) As Double
'

'Creates the Rates Tree
    RateTree(1, 1) = InitialRate
    For i = 1 To TotalPeriods
        For j = 2 To TotalPeriods
            If RateTree(i, j - 1) <> 0 Then
                RateTree(i, j) = RateTree(i, j - 1) + UpMove
            Else
                If RateTree(i - 1, j - 1) <> 0 Then
                    RateTree(i, j) = RateTree(i - 1, j - 1) + DownMove
                    If RateTree(i, j) <= 0 Then
                        RateTree(i, j) = 0.0001
                    Else: End If
                Else: End If
            End If
        Next j
    Next i
'

'Finds the Implied Risk-Neutral Probability of Up Move using the Secant Method
    ProbUp(0) = 0
    ProbUp(1) = 0.9999

    For k = 0 To 1
    'Creates the Money Market Account Tree
        For i = 1 To BondPeriods
            MMATree(i, BondPeriods) = ParValue
            If RateTree(i, BondPeriods - 1) <> 0 Then
                MMATree(i, BondPeriods - 1) = MMATree(i, BondPeriods) _
                    / (1 + RateTree(i, BondPeriods - 1))
            Else
                MMATree(i, BondPeriods - 1) = 0
            End If
        Next i
    
        For j = (BondPeriods - 2) To 1 Step -1
            For i = 1 To (BondPeriods - 1)
                If RateTree(i + 1, j + 1) <> 0 Then
                    MMATree(i, j) = (ProbUp(k) * MMATree(i, j + 1) + (1 - ProbUp(k)) * _
                        MMATree(i + 1, j + 1)) / (1 + RateTree(i, j))
                Else
                    MMATree(i, j) = 0
                End If
            Next i
        Next j
        
        EstPrice(k) = MMATree(1, 1)
    '
    Next k

    'Estimates Next Probability
        ProbUp(2) = ProbUp(1) - (EstPrice(1) - BondValue) * (ProbUp(1) - ProbUp(0)) / _
            (EstPrice(1) - EstPrice(0))

    For k = 2 To 9999
    'Creates the Money Market Account Tree
        For i = 1 To BondPeriods
            MMATree(i, BondPeriods) = ParValue
            If RateTree(i, BondPeriods - 1) <> 0 Then
                MMATree(i, BondPeriods - 1) = MMATree(i, BondPeriods) _
                    / (1 + RateTree(i, BondPeriods - 1))
            Else
                MMATree(i, BondPeriods - 1) = 0
            End If
        Next i
    
        For j = (BondPeriods - 2) To 1 Step -1
            For i = 1 To (BondPeriods - 1)
                If RateTree(i + 1, j + 1) <> 0 Then
                    MMATree(i, j) = (ProbUp(k) * MMATree(i, j + 1) + (1 - ProbUp(k)) * _
                        MMATree(i + 1, j + 1)) / (1 + RateTree(i, j))
                Else
                    MMATree(i, j) = 0
                End If
            Next i
        Next j
    
        EstPrice(k) = MMATree(1, 1)
    
        If EstPrice(k) - EstPrice(k - 1) = 0 Then
            ProbUp(10000) = ProbUp(k)
            Exit For
        Else
            ProbUp(k + 1) = ProbUp(k) - (EstPrice(k) - BondValue) * (ProbUp(k) - ProbUp(k - 1)) / _
                (EstPrice(k) - EstPrice(k - 1))
        End If
    '
    Next k
'

'Creates the Call Pricing Tree
    For i = 1 To OptionPeriods
        CallTree(i, OptionPeriods) = MMATree(i, OptionPeriods) - Strike
        If CallTree(i, OptionPeriods) < 0 Then
            CallTree(i, OptionPeriods) = 0
        Else: End If
    Next i

    For j = (OptionPeriods - 1) To 1 Step -1
        For i = 1 To (OptionPeriods - 1)
            If RateTree(i + 1, j + 1) <> 0 Then
                CallTree(i, j) = (ProbUp(10000) * CallTree(i, j + 1) + (1 - ProbUp(10000)) * _
                    CallTree(i + 1, j + 1)) / (1 + RateTree(i, j))
            Else
                CallTree(i, j) = 0
            End If
        Next i
    Next j
'

'Creates the Put Pricing Tree
    For i = 1 To OptionPeriods
        PutTree(i, OptionPeriods) = Strike - MMATree(i, OptionPeriods)
        If PutTree(i, OptionPeriods) < 0 Then
            PutTree(i, OptionPeriods) = 0
        Else: End If
    Next i

    For j = (OptionPeriods - 1) To 1 Step -1
        For i = 1 To (OptionPeriods - 1)
            If RateTree(i + 1, j + 1) <> 0 Then
                PutTree(i, j) = (ProbUp(10000) * PutTree(i, j + 1) + (1 - ProbUp(10000)) * _
                    PutTree(i + 1, j + 1)) / (1 + RateTree(i, j))
            Else
                PutTree(i, j) = 0
            End If
        Next i
    Next j
'

'Prints the Trees
    Sheets(1).Range("A13:AAA1000").Clear
    
    'Formats Sheet
        Range("A13:AAA1000").Select
        Selection.Interior.ThemeColor = xlThemeColorDark1
    '
    
    'Formats Rates Tree
        Range(Cells(13, 1), Cells(14, TotalPeriods)).Merge
        Range(Cells(13, 1), Cells(14, TotalPeriods)). _
            HorizontalAlignment = xlCenter
        Range(Cells(14, 1), Cells(14, TotalPeriods)).Font.Underline = True
        Range(Cells(15, 1), Cells(TotalPeriods + 14, TotalPeriods)).NumberFormat = "0.0%"
        With Range("A13")
            .Value = "Rates Tree"
            .Font.Size = "24"
            .ShrinkToFit = True
            .Font.Bold = True
        End With
        Range("A14").Value = "Today"
        Range("B14").Value = "Period 1"
        For i = 3 To TotalPeriods
            Cells(14, i).Value = "Period " & i - 1
        Next i
    '

    'Formats Discount Bond Price Tree
        Range(Cells(TotalPeriods + 16, 1), Cells(TotalPeriods + 16, BondPeriods)).Merge
        Range(Cells(TotalPeriods + 16, 1), Cells(TotalPeriods + 17, BondPeriods)).HorizontalAlignment = xlCenter
        Range(Cells(TotalPeriods + 17, 1), Cells(TotalPeriods + 17, BondPeriods)).Font.Underline = True
        Range(Cells(TotalPeriods + 18, 1), Cells(2 * TotalPeriods + 18, BondPeriods)).NumberFormat = "0.000"
        With Range("A" & TotalPeriods + 16)
            .Value = "Discount Bond Price Tree"
            .Font.Size = "24"
            .ShrinkToFit = True
            .Font.Bold = True
        End With
        Range("A" & TotalPeriods + 17).Value = "Today"
        Range("B" & TotalPeriods + 17).Value = "Period 1"
        For i = 3 To BondPeriods
            Cells(TotalPeriods + 17, i).Value = "Period " & i - 1
        Next i
    '
    
    'Formats Call Option Tree
        Range(Cells(TotalPeriods + OptionPeriods + BondPeriods + 16, 1), Cells(TotalPeriods + OptionPeriods + BondPeriods + 16, OptionPeriods)).Merge
        Range(Cells(TotalPeriods + OptionPeriods + BondPeriods + 16, 1), Cells(TotalPeriods + OptionPeriods + BondPeriods + 17, OptionPeriods)).HorizontalAlignment = xlCenter
        Range(Cells(TotalPeriods + OptionPeriods + BondPeriods + 17, 1), Cells(TotalPeriods + OptionPeriods + BondPeriods + 17, OptionPeriods)).Font.Underline = True
        Range(Cells(TotalPeriods + OptionPeriods + BondPeriods + 18, 1), Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 17, OptionPeriods)).NumberFormat = "0.000"
        With Range("A" & TotalPeriods + OptionPeriods + BondPeriods + 16)
            .Value = "Call Option Price Tree"
            .Font.Size = "24"
            .ShrinkToFit = True
            .Font.Bold = True
        End With
        Range("A" & TotalPeriods + BondPeriods + OptionPeriods + 17).Value = "Today"
        Range("B" & TotalPeriods + BondPeriods + OptionPeriods + 17).Value = "Period 1"
        For i = 3 To OptionPeriods
            Cells(TotalPeriods + BondPeriods + OptionPeriods + 17, i).Value = "Period " & i - 1
        Next i
    '
    
    'Formats Put Option Tree
        Range(Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 19, 1), Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 19, OptionPeriods)).Merge
        Range(Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 19, 1), Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 20, OptionPeriods)).HorizontalAlignment = xlCenter
        Range(Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 20, 1), Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 20, OptionPeriods)).Font.Underline = True
        Range(Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 21, 1), Cells(TotalPeriods + 3 * OptionPeriods + BondPeriods + 20, OptionPeriods)).NumberFormat = "0.000"
        With Range("A" & TotalPeriods + 2 * OptionPeriods + BondPeriods + 19)
            .Value = "Put Option Price Tree"
            .Font.Size = "24"
            .ShrinkToFit = True
            .Font.Bold = True
        End With
        Range("A" & TotalPeriods + BondPeriods + 2 * OptionPeriods + 20).Value = "Today"
        Range("B" & TotalPeriods + BondPeriods + 2 * OptionPeriods + 20).Value = "Period 1"
        For i = 3 To OptionPeriods
            Cells(TotalPeriods + BondPeriods + 2 * OptionPeriods + 20, i).Value = "Period " & i - 1
        Next i
    '
    
    'Prints Trees
        For i = 1 To TotalPeriods
            For j = 1 To TotalPeriods
                If RateTree(i, j) <> 0 Then
                    Cells(i + 14, j).Value = RateTree(i, j)
                Else
                    Cells(i + 14, j) = Empty
                End If
            Next j
        Next i

        For i = 1 To BondPeriods
            For j = 1 To BondPeriods
                If RateTree(i, j) <> 0 Then
                    Cells(i + TotalPeriods + 17, j).Value = MMATree(i, j)
                Else
                    Cells(i + TotalPeriods + 17, j).Value = Empty
                End If
            Next j
        Next i

        For i = 1 To OptionPeriods
            For j = 1 To OptionPeriods
                If RateTree(i, j) <> 0 Then
                    Cells(i + TotalPeriods + BondPeriods + OptionPeriods + 17, j).Value = CallTree(i, j)
                Else
                    Cells(i + TotalPeriods + BondPeriods + OptionPeriods + 17, j).Value = Empty
                End If
            Next j
        Next i
        
        For i = 1 To OptionPeriods
            For j = 1 To OptionPeriods
                If RateTree(i, j) <> 0 Then
                    Cells(i + TotalPeriods + BondPeriods + 2 * OptionPeriods + 20, j).Value = PutTree(i, j)
                Else
                    Cells(i + TotalPeriods + BondPeriods + 2 * OptionPeriods + 20, j).Value = Empty
                End If
            Next j
        Next i
    '
    
    'Prints Final Values
        Range("L5").Value = ProbUp(10000)
        Range("L6").Value = CallTree(1, 1)
        Range("L7").Value = PutTree(1, 1)
    '
'

End Sub