Binomial Tree VBA

[Kotepie]

Hello-I have a VBA code that builds a binomial tree for a given set of data once I hit the calculate button. One such data is the number of time steps which is given me the trouble. The code seems to be limited to just n=9 after which (if I put n=10 or 11 0r 12 etc.)I get a application-defined or object defined error (run time error"1004'). How do I extend it to say n=50 ? Thank you

Sub BinTree()

' Application.ScreenUpdating = False
' Application.StatusBar = "Building Binomial Tree ..."

Dim i As Integer, j As Integer, K As Integer, n As Integer
Dim stock As Double, strike As Double, intrate As Double, vol As Double, mat As Double, deltat As Double
Dim up As Double, down As Double, prob As Double
Dim discfactor As Double
Dim premium As Double

Sheets("Sheet1").Select
Range("E1:O43").Select
Selection.Clear

stock = CDbl(Range("B4"))
strike = CDbl(Range("B5"))
intrate = CDbl(Range("B6"))
vol = CDbl(Range("B7"))
mat = CDbl(Range("B8"))
n = CInt(Range("B9"))
deltat = CDbl(Range("B10"))

up = Exp(vol * Sqr(deltat))
down = Exp(-vol * Sqr(deltat))
prob = (Exp(intrate * deltat) - down) / (up - down)
discfactor = Exp(-intrate * deltat)


Range("E20").Select
ActiveCell.Value = stock
ActiveCell.Font.Name = "Calibri"
ActiveCell.Font.Size = 11
ActiveCell.Font.ColorIndex = 11
ActiveCell.NumberFormat = "0.0000"
ActiveCell.Borders.LineStyle = xlContinuous

' Build the binomial tree of stock prices
For i = 1 To n
For j = 1 To i
Cells(4 * j + (16 - 2 * i), i + 5).Value = up * Cells(4 * j + (18 - 2 * i), i + 4).Value
Cells(4 * j + (16 - 2 * i), i + 5).Select
With Selection
.Font.Name = "Calibri"
.Font.Size = 11
.Font.ColorIndex = 11
.NumberFormat = "0.0000"
.Borders.LineStyle = xlContinuous
End With
Next j
Cells(20 + 2 * i, i + 5).Value = down * Cells(18 + 2 * i, i + 4).Value
Cells(20 + 2 * i, i + 5).Select
With Selection
.Font.Name = "Calibri"
.Font.Size = 11
.Font.ColorIndex = 11
.NumberFormat = "0.0000"
.Borders.LineStyle = xlContinuous
End With
Next i

' Calculation of final payoff values
For j = 1 To n + 1
Cells(4 * j + (17 - 2 * n), n + 5).Value = WorksheetFunction.Max(Cells(4 * j + (16 - 2 * n), n + 5).Value - strike, 0)
Cells(4 * j + (17 - 2 * n), n + 5).Select
With Selection
.Font.Name = "Calibri"
.Font.Size = 11
.Font.ColorIndex = 3
.NumberFormat = "0.0000"
.Borders.LineStyle = xlContinuous
End With
Next j

' Build the tree of option values
For i = n To 1 Step -1
For j = 1 To i
Cells(4 * j + (19 - 2 * i), i + 4).Value = discfactor * (prob * Cells(4 * j + (17 - 2 * i), i + 5) + (1 - prob) * Cells(4 * j + (21 - 2 * i), i + 5))
Cells(4 * j + (19 - 2 * i), i + 4).Select
With Selection
.Font.Name = "Calibri"
.Font.Size = 11
.Font.ColorIndex = 3
.NumberFormat = "0.0000"
.Borders.LineStyle = xlContinuous
End With
Next j
Next i

premium = Cells(21, 5).Value


Range("B14").Value = premium


' Application.ScreenUpdating = True
' Application.StatusBar = False

End Sub

 

[StephenCrump]

You're running out of real estate, and you need to adjust your cell numbering.

When i = 10 (and j =1)

Cells(4 * j + (16 - 2 * i), i + 5).Value = .....

refers to Cells(0, 15) hence the error.