Pricings European Options on Discount Bonds in VBA

Use this Excel program to price calls and puts on discount bonds in a binomial framework.


Download Excel Spreadsheet to forecast Discount Bond Prices


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 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

Sub RatesTree()

'Insert Values
    Strike = Range("C5").Value
    TimeToExpiration = Range("C6").Value
    ParValue = Range("C9").Value
    YearsToMaturity = Range("C10").Value
    
    InitialRate = Range("H5").Value
    UpMove = Range("H6").Value
    DownMove = Range("H7").Value
    ProbUp = Range("H8").Value
    TotalYears = Range("H9").Value
    PeriodsPerYear = Range("H10").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
'

'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 * MMATree(i, j + 1) + (1 - ProbUp) * _
                    MMATree(i + 1, j + 1)) / (1 + RateTree(i, j))
            Else
                MMATree(i, j) = 0
            End If
        Next i
    Next j
'

'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 * CallTree(i, j + 1) + (1 - ProbUp) * _
                    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 * PutTree(i, j + 1) + (1 - ProbUp) * _
                    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("A12:AAA1000").Clear
    
    'Formats Sheet
        Range("A12:AAA1000").Select
        Selection.Interior.ThemeColor = xlThemeColorDark1
    '
    
    'Formats Rates Tree
        Range(Cells(12, 1), Cells(12, TotalPeriods)).Merge
        Range(Cells(12, 1), Cells(13, TotalPeriods)). _
            HorizontalAlignment = xlCenter
        Range(Cells(13, 1), Cells(13, TotalPeriods)).Font.Underline = True
        Range(Cells(14, 1), Cells(TotalPeriods + 13, TotalPeriods)).NumberFormat = "0.0%"
        With Range("A12")
            .Value = "Rates Tree"
            .Font.Size = "24"
            .ShrinkToFit = True
            .Font.Bold = True
        End With
        Range("A13").Value = "Today"
        Range("B13").Value = "Period 1"
        For i = 3 To TotalPeriods
            Cells(13, i).Value = "Period " & i - 1
        Next i
    '

    'Formats Discount Bond Price Tree
        Range(Cells(TotalPeriods + 15, 1), Cells(TotalPeriods + 15, BondPeriods)).Merge
        Range(Cells(TotalPeriods + 15, 1), Cells(TotalPeriods + 16, BondPeriods)).HorizontalAlignment = xlCenter
        Range(Cells(TotalPeriods + 16, 1), Cells(TotalPeriods + 16, BondPeriods)).Font.Underline = True
        Range(Cells(TotalPeriods + 17, 1), Cells(2 * TotalPeriods + 17, BondPeriods)).NumberFormat = "0.000"
        With Range("A" & TotalPeriods + 15)
            .Value = "Discount Bond Price Tree"
            .Font.Size = "24"
            .ShrinkToFit = True
            .Font.Bold = True
        End With
        Range("A" & TotalPeriods + 16).Value = "Today"
        Range("B" & TotalPeriods + 16).Value = "Period 1"
        For i = 3 To BondPeriods
            Cells(TotalPeriods + 16, i).Value = "Period " & i - 1
        Next i
    '
    
    'Formats Call Option Tree
        Range(Cells(TotalPeriods + OptionPeriods + BondPeriods + 15, 1), Cells(TotalPeriods + OptionPeriods + BondPeriods + 15, OptionPeriods)).Merge
        Range(Cells(TotalPeriods + OptionPeriods + BondPeriods + 15, 1), Cells(TotalPeriods + OptionPeriods + BondPeriods + 16, OptionPeriods)).HorizontalAlignment = xlCenter
        Range(Cells(TotalPeriods + OptionPeriods + BondPeriods + 16, 1), Cells(TotalPeriods + OptionPeriods + BondPeriods + 16, OptionPeriods)).Font.Underline = True
        Range(Cells(TotalPeriods + OptionPeriods + BondPeriods + 17, 1), Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 16, OptionPeriods)).NumberFormat = "0.000"
        With Range("A" & TotalPeriods + OptionPeriods + BondPeriods + 15)
            .Value = "Call Option Price Tree"
            .Font.Size = "24"
            .ShrinkToFit = True
            .Font.Bold = True
        End With
        Range("A" & TotalPeriods + BondPeriods + OptionPeriods + 16).Value = "Today"
        Range("B" & TotalPeriods + BondPeriods + OptionPeriods + 16).Value = "Period 1"
        For i = 3 To OptionPeriods
            Cells(TotalPeriods + BondPeriods + OptionPeriods + 16, i).Value = "Period " & i - 1
        Next i
    '
    
    'Formats Put Option Tree
        Range(Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 18, 1), Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 18, OptionPeriods)).Merge
        Range(Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 18, 1), Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 19, OptionPeriods)).HorizontalAlignment = xlCenter
        Range(Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 19, 1), Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 19, OptionPeriods)).Font.Underline = True
        Range(Cells(TotalPeriods + 2 * OptionPeriods + BondPeriods + 20, 1), Cells(TotalPeriods + 3 * OptionPeriods + BondPeriods + 19, OptionPeriods)).NumberFormat = "0.000"
        With Range("A" & TotalPeriods + 2 * OptionPeriods + BondPeriods + 18)
            .Value = "Put Option Price Tree"
            .Font.Size = "24"
            .ShrinkToFit = True
            .Font.Bold = True
        End With
        Range("A" & TotalPeriods + BondPeriods + 2 * OptionPeriods + 19).Value = "Today"
        Range("B" & TotalPeriods + BondPeriods + 2 * OptionPeriods + 19).Value = "Period 1"
        For i = 3 To OptionPeriods
            Cells(TotalPeriods + BondPeriods + 2 * OptionPeriods + 19, 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 + 13, j).Value = RateTree(i, j)
                Else
                    Cells(i + 13, 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 + 16, j).Value = MMATree(i, j)
                Else
                    Cells(i + TotalPeriods + 16, 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 + 16, j).Value = CallTree(i, j)
                Else
                    Cells(i + TotalPeriods + BondPeriods + OptionPeriods + 16, 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 + 19, j).Value = PutTree(i, j)
                Else
                    Cells(i + TotalPeriods + BondPeriods + 2 * OptionPeriods + 19, j).Value = Empty
                End If
            Next j
        Next i
    '
    
    'Prints Final Values
        Range("L5").Value = MMATree(1, 1)
        Range("L6").Value = CallTree(1, 1)
        Range("L7").Value = PutTree(1, 1)
    '
'

End Sub