Forward Rates in VBA

Use this Excel program to calculate the forward rates implied by any yield curve up to 5 years in advance.


Download Excel Spreadsheet to Calculate Forward Rates with VBA




The code underlying the procedure is as follows:



'Created by Ron Akke at www.ronakke.com

Public Data As Variant, ws As Worksheet, fwd As Double
Public i, j, k As Integer
Public BEY() As Double, APY() As Double, YC() As Double

Sub Yield_Curve()

'Sets the dimensions for each array
    ReDim BEY(11) As Double
    ReDim APY(11) As Double
    ReDim YC(360, 360) As Double
'

'Loads Data From File into Computer Memory
    Data = Sheets(1).Range("B8:C18").Value
    fwd = Sheets(1).Range("C5").Value
'

'Creates Bond Equivalent Yield (BEY) Variable
    For i = 1 To 11
        BEY(i) = Data(i, 2)
    Next i
'

'Converts BEY to Annual Percentage Yield (APY)
    For i = 1 To 11
        APY(i) = (1 + BEY(i) / 2) ^ 2 - 1
    Next i
'

'Sets Yield Curve Values for Known APY's
    YC(0, 1) = APY(1)
    YC(0, 3) = APY(2)
    YC(0, 6) = APY(3)
    YC(0, 12) = APY(4)
    YC(0, 24) = APY(5)
    YC(0, 36) = APY(6)
    YC(0, 60) = APY(7)
    YC(0, 84) = APY(8)
    YC(0, 120) = APY(9)
    YC(0, 240) = APY(10)
    YC(0, 360) = APY(11)
'

'Linearly Interpolates Yield Curve at Monthly Interval
    For i = 1 To 360
        If YC(0, i) <> 0 Then
        Else
            For j = i + 1 To 360
                If YC(0, j) = 0 Then
                Else
                    For k = i To j - 1
                        YC(0, k) = YC(0, i - 1) + (k - i + 1) * _
                            (YC(0, j) - YC(0, i - 1)) / (j - i + 1)
                    Next k
                    Exit For
                End If
            Next j
        End If
    Next i
'

'Finds the No-Arbitrage Forward Yield Curve
    For k = 1 To 359
        For i = 1 To (360 - k)
            YC(k, i) = (((1 + YC(0, k + i)) ^ ((k + i) / 12)) _
                / ((1 + YC(0, k))) ^ (k / 12)) ^ (12 / i) - 1
        Next i
    Next k
'

'Prints Results
    'Creates Results Worksheet
        Application.DisplayAlerts = False
        For i = 1 To Worksheets.Count
            If Sheets(i).Name = "Results" Then
                Sheets("Results").Delete
                Exit For
            Else: End If
        Next i
        Application.DisplayAlerts = True
        
        Sheets.Add After:=Sheets(1)
        Sheets(2).Activate
        Sheets(2).Name = "Results"
    '
    
    'Prints Labels in Results Worksheet
        Range("A1").Value = "Months to Maturity"
        Range("B1").Value = "Current YC"
        Range("C1").Value = fwd & " Months Forward"
    
        For i = 1 To 360
            If i = 1 Then
                Range("A" & i + 1).Value = i & " month"
                Else: End If
            If i < 12 Then
                Range("A" & i + 1).Value = i & " months"
            Else: End If
            If i >= 12 Then
                k = Fix(i / 12)
                    If k = 1 Then
                        If (i - (12 * k)) = 1 Then
                            Range("A" & i + 1).Value = k & _
                                " year, " & i - (12 * k) & " month"
                        Else
                            Range("A" & i + 1).Value = k & _
                                " year, " & i - (12 * k) & " months"
                        End If
                    Else
                        If (i - (12 * k)) = 1 Then
                            Range("A" & i + 1).Value = k & _
                                " years, " & i - (12 * k) & " month"
                        Else
                            Range("A" & i + 1).Value = k & _
                                " years, " & i - (12 * k) & " months"
                        End If
                    End If
            Else: End If
        Next i
    '
    
    'Prints Values in Results Worksheet
        For i = 1 To 360
            Cells(i + 1, 2).Value = YC(0, i)
            Cells(i + 1, 3).Value = YC(fwd, i)
        Next i
    '

    'Formats Results Worksheet
        Range(Cells(2, 2), Cells(2 + 361, 3)).NumberFormat = "0.00%"
        With Range("A:C")
            .HorizontalAlignment = xlCenter
            .EntireColumn.AutoFit
        End With
    '
'

'Prints Forward Rates and Graphs on First Worksheet
    'Prints Values
        Sheets(1).Activate
        With Range("B8:C18")
            .NumberFormat = "0.00%"
            .HorizontalAlignment = xlCenter
            .EntireColumn.AutoFit
        End With
        Range("F8").Value = YC(fwd, 1)
        Range("F9").Value = YC(fwd, 3)
        Range("F10").Value = YC(fwd, 6)
        Range("F11").Value = YC(fwd, 12)
        Range("F12").Value = YC(fwd, 24)
        Range("F13").Value = YC(fwd, 36)
        Range("F14").Value = YC(fwd, 60)
        Range("F15").Value = YC(fwd, 84)
        Range("F16").Value = YC(fwd, 120)
        Range("F17").Value = YC(fwd, 240)
    '

    'Creates Yield Curve Chart
        Range("A14").Select
        ActiveSheet.Shapes.AddChart.Select
        With ActiveChart
            .SetSourceData Source:=Sheets("Results").Range("A1:C" & 361 - fwd)
            .ChartType = xlLine
            .HasTitle = False
            .HasTitle = True
            .ChartTitle.Text = "Current and Forward Yield Curves"
            .SeriesCollection(1).Name = "Current"
            .SeriesCollection(2).Name = "Forward"
            With .Axes(xlCategory)
                .TickLabels.NumberFormat = "#"
                .TickLabels.Font.Size = 8
                .TickLabels.Orientation = 45
                .TickLabelSpacing = 36
                .HasTitle = True
                .AxisTitle.Characters.Text = "Months to Maturity"
            End With
        End With
    '
'

End Sub