17th Jul - B&S in VBA

'Coding and validation by Juhani Huopainen (2005). All rights reserved.
'
'************
'INTRODUCTION
'************
'This is the Black-76 option pricing model for European options on futures.
'It is an extension of the original Black & Scholes (1973)option pricing model.
'Original paper for reference:
'  Black, Fischer, "The Pricing of Commodity Contracts", Journal of Financial Economics, No. 3, 1976, p. 167-169
'
'*********
'Variables
'*********
'  Optiontype = optiontype in textformat, either "C" (for call) or "P" for put
'  Forward    = price of the underlying forward
'  Strike     = exerciseprice of the option in question
'  Interest   = domestic interest rate, annual continuously compounded rate
'  Volatility = annualized volatility of forward before option expiry in percentage terms
'  Lifetime   = time before option expiry in years. (e.g. 6 months = 1/2)
'  Optionprice= price of the option, assuming it is known
' InstrumentCode= Standard NoPO instrument code for the option, e.g. ENOP33YR-07
'
'*************
'Userfunctions
'*************
'The userfunctions are listed here, together with the variables they request
'BlackPrice
'   Parameters: Optiontype, Forward, Strike, Interest, Volatility, Lifetime
'   Result: Option price
'Delta
'   Parameters: Optiontype, Forward, Strike, Interest, Volatility, Lifetime
'   Result: Option delta, which is below -1 and 0 for puts and 0 and 1 for calls
'Gamma
'   Parameters: Forward, Strike, Interest, Volatility, Lifetime
'   Result: Option's Gamma, which measures the sensitivity of
'           delta to forward's price changes
'Theta
'   Parameters: Optiontype , Forward, Strike, Interest, Volatility, Lifetime
'   Result: Option's daily price loss because of time decay
''Vega
'   Parameters: Forward, Strike, Interest, Volatility, Lifetime
'   Result: The sensitivity of price to a change of 1% in volatility
'Rho
'   Parameters: Optiontype, Forward, Strike, Interest, Volatility, Lifetime
'   Result: Sensitivity of price to a change of 1% in interest rate
'
'OPTION PRICE
Function BlackPrice(Optiontype, Forward, Strike, Interest, Volatility, Lifetime)
OptionH = (Log(Forward / Strike) + (Volatility ^ 2 / 2) * Lifetime) / (Volatility * Sqr(Lifetime))
If Optiontype = "C" Then BlackPrice = Forward * Exp(-Interest * Lifetime) _
    * Application.WorksheetFunction.NormSDist(OptionH) - Strike * Exp(-Interest * Lifetime) _
    * Application.WorksheetFunction.NormSDist(OptionH - Volatility * Sqr(Lifetime))
If Optiontype = "P" Then BlackPrice = -Forward * Exp(-Interest * Lifetime) _
    * Application.WorksheetFunction.NormSDist(-OptionH) + Strike * Exp(-Interest * Lifetime) _
    * Application.WorksheetFunction.NormSDist(Volatility * Sqr(Lifetime) - OptionH)
    End Function
'
'Next the greeks (delta, gamma, theta, vega and rho) are calculated
'
'DELTA
Function Delta(Optiontype, Forward, Strike, Interest, Volatility, Lifetime)
OptionH = (Log(Forward / Strike) + (Volatility ^ 2 / 2) * Lifetime) / (Volatility * Sqr(Lifetime))
If Optiontype = "C" Then Delta = Exp(-Interest * Lifetime) * Application.WorksheetFunction.NormSDist(OptionH)
If Optiontype = "P" Then Delta = -Exp(-Interest * Lifetime) * Application.WorksheetFunction.NormSDist(-OptionH)
End Function
'
'GAMMA
Function Gamma(Forward, Strike, Interest, Volatility, Lifetime)
OptionH = (Log(Forward / Strike) + (Volatility ^ 2 / 2) * Lifetime) / (Volatility * Sqr(Lifetime))
Gamma = (1 / Sqr(2 * 3.14159) * Exp(-((OptionH ^ 2)) / 2) _
     * Exp(-Interest * Lifetime)) / (Forward * Volatility * Sqr(Lifetime))
End Function
'
'THETA
Function Theta(Optiontype, Forward, Strike, Interest, Volatility, Lifetime)
OptionH = (Log(Forward / Strike) + (Volatility ^ 2 / 2) * Lifetime) / (Volatility * Sqr(Lifetime))
If Optiontype = "C" Then theta1 = -Interest * Forward * Exp(-Interest * Lifetime) _
    * Application.WorksheetFunction.NormSDist(OptionH)
If Optiontype = "P" Then theta1 = Interest * Forward * Exp(-Interest * Lifetime) _
    * Application.WorksheetFunction.NormSDist(-OptionH)
If Optiontype = "C" Then theta2 = Interest * Strike * Exp(-Interest * Lifetime) _
    * Application.WorksheetFunction.NormSDist(OptionH - Volatility * Sqr(Lifetime))
If Optiontype = "P" Then theta2 = -Interest * Strike * Exp(-Interest * Lifetime) _
    * Application.WorksheetFunction.NormSDist(Volatility * Sqr(Lifetime) - OptionH)
theta3 = Forward * Exp(-Interest * Lifetime) * Volatility _
    * ((1 / Sqr(2 * 3.14159)) * Exp(-(OptionH ^ 2) / 2)) / 2 * Sqr(Lifetime)
Theta = (theta1 + theta2 + theta3) / 365
If Theta < 0 Then Theta = 0
End Function
'
'VEGA
    Function Vega(Forward, Strike, Interest, Volatility, Lifetime)
OptionH = (Log(Forward / Strike) + (Volatility ^ 2 / 2) * Lifetime) / (Volatility * Sqr(Lifetime))
Vega = ((Forward * Exp(-Interest * Lifetime) * _
    (1 / Sqr(2 * 3.14159)) * Exp((-OptionH ^ 2) / 2) * Sqr(Lifetime))) / 100
End Function

'RHO
Function Rho(Optiontype, Forward, Strike, Interest, Volatility, Lifetime)
OptionH = (Log(Forward / Strike) + (Volatility ^ 2 / 2) * Lifetime) / (Volatility * Sqr(Lifetime))
Rho = -Lifetime * BlackPrice(Optiontype, Forward, Strike, Interest, Volatility, Lifetime)
End Function
'
'IMPLIED VOLATILITY
Function ImpVol(Optiontype, Forward, Strike, Interest, Optionprice, Lifetime)
    High = 2
    Low = 0
    Do While (High - Low) > 0.0001
    If BlackPrice(Optiontype, Forward, Strike, Interest, (High + Low) / 2, Lifetime) > _
        Optionprice Then
             High = (High + Low) / 2
             Else: Low = (High + Low) / 2
    End If
    Loop
    ImpVol = (High + Low) / 2
End Function




X X X X X X X X X X

'**************************
'*** OPTION LIST UPDATE ***
'**************************
'
Private Sub Updatelistbutton_Click()
RESPONSE = MsgBox("Päivitä optiolista ja päätöskurssit - Oletko varma?", vbOKCancel)
If RESPONSE = vbCancel Then MsgBox ("Päivitys peruttu")
If RESPONSE = vbCancel Then Exit Sub
'
'Activate automatic calculation
'
With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
    End With
'
'
'Delete old symbols
'
Range("A9:A200").Select
Selection.ClearContents
'
'Retrieve number of options and show it
'
Channelnumber = Application.DDEInitiate(App:="ert", Topic:="active_options")
xx = Application.DDERequest(Channelnumber, "count")
xx = Range("J6").Value
MsgBox ("Aktiivisten optioiden määrä on  " & xx)
'
'Show option symbols
'
For i = 1 To Range("J6")
Worksheets("Optiohinnat").Cells(8 + i, 1) = Application.DDERequest(Channelnumber, i)
Next i
Application.DDETerminate (Channelnumber)
'
'Begin sorting data, first by expiry, then by call/put type, finally strike
'
Range("B9").Select
Selection.EntireColumn.Insert
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-1],5)"
Range("B9").Select
Selection.Copy

ActiveSheet.Range(Cells(9, 2), Cells(xx + 8, 2)).Select

'ActiveSheet.Range(Cells(FirstRow, FirstCol), _
 '   Cells(LastRow, LastCol)).Select

ActiveSheet.Paste
Application.CutCopyMode = False

ActiveSheet.Range(Cells(9, 1), Cells(xx + 8, 2)).Select

Worksheets("Optiohinnat").Range("A9:B164").Sort Key1:=Worksheets("Optiohinnat").Range("B9"), Order1:=xlAscending, _
Key2:=Worksheets("Optiohinnat").Range("A9"), Order2:=xlAscending
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
'
'Justify Column
'
ActiveSheet.Range(Cells(9, 1), Cells(xx + 8, 1)).Select
   
   
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
'
'Show expiry dates for options
'
With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
    End With
For i = 1 To Range("J6")
tickersymbol = Cells(8 + i, 1)
Forwardsymbol = "ENO" + Right(tickersymbol, 5)
    For x = 1 To 10
    Worksheets("Data").Activate
    If Worksheets("Data").Cells(4 + x, 1) = Forwardsymbol Then Expirydate = Worksheets("Data").Cells(4 + x, 4)
    Next x
Worksheets("Optiohinnat").Cells(8 + i, 6) = Expirydate
Next i
'
'Show interest rates for options
'
With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
    End With
For i = 1 To Range("J6")
tickersymbol = Cells(8 + i, 1)
Forwardsymbol = "ENO" + Right(tickersymbol, 5)
    For x = 1 To 10
    Worksheets("Data").Activate
    If Worksheets("Data").Cells(4 + x, 1) = Forwardsymbol Then InterestRate = Worksheets("Data").Cells(4 + x, 7)
    Next x
Worksheets("Optiohinnat").Cells(8 + i, 7) = InterestRate
Next i
'
'De-activate automatic calculation
'
    With Application
        .Calculation = xlManual
        .MaxChange = 0.001
    End With
    ActiveWorkbook.PrecisionAsDisplayed = False
MsgBox ("Lista päivitetty.")
Worksheets("Optiohinnat").Activate
End Sub

'***************************
'*** OPTION PRICE UPDATE ***
'***************************
Private Sub UpdatePricesButton_Click()
'
For i = 1 To Range("J6")
tickersymbol = Cells(8 + i, 1)
Queryformula = "=ert|'/Nordpool - optiot/" & tickersymbol + "'!'Index=0?Closing Price'"
Cells(8 + i, 8).Formula = "=ert|'/Nordpool - optiot/" & tickersymbol + "'!'Index=0?Historiallinen kehitys'"
Next i

'Calculate cells, then stop automatic calculation
With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
    End With
    ActiveWorkbook.PrecisionAsDisplayed = False
    With Application
        .Calculation = xlManual
        .MaxChange = 0.001
    End With
    ActiveWorkbook.PrecisionAsDisplayed = False
'
'Show forward settlement prices
'
For i = 1 To Range("J6")
tickersymbol = Cells(8 + i, 1)
Forwardsymbol = Right(tickersymbol, 5)
If Left(Forwardsymbol, 1) = "Y" Then Forwardtype = "Nordpool - vuosituotteet/"
If Left(Forwardsymbol, 1) = "Q" Then Forwardtype = "Nordpool - kausituotteet/"
Cells(8 + i, 2).Formula = "=ert|'/" & Forwardtype + "ENO" & Forwardsymbol + "'!ClosingPrice"
Next i
'
'Show forward mid-prices
'
For i = 1 To Range("J6")
tickersymbol = Cells(8 + i, 1)
Forwardsymbol = Right(tickersymbol, 5)
If Left(Forwardsymbol, 1) = "Y" Then Forwardtype = "Nordpool - vuosituotteet/"
If Left(Forwardsymbol, 1) = "Q" Then Forwardtype = "Nordpool - kausituotteet/"
Cells(8 + i, 3).Formula = "=(ert|'/" & Forwardtype + "ENO" & Forwardsymbol + "'!BestBid" + "+ert|'/" & Forwardtype + "ENO" & Forwardsymbol + "'!BestAsk)/2"
Next i
'
'Activate and then deactivate automatic calculation
'
With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
    End With
    ActiveWorkbook.PrecisionAsDisplayed = False
    With Application
        .Calculation = xlManual
        .MaxChange = 0.001
    End With
    ActiveWorkbook.PrecisionAsDisplayed = False
MsgBox ("Optiohinnat päivitetty.")
Worksheets("Optiohinnat").Activate
End Sub


X X X X X X X X X X X X

Private Sub Portfoliobutton_Click()
'begin primary update loop
'
For i = 1 To 10
tickersymbol = Cells(7 + i, 1)
If tickersymbol = "" Then MsgBox ("Salkkutiedot päivitetty.")
If tickersymbol = "" Then Worksheets("Salkku").Activate
If tickersymbol = "" Then Exit Sub

Forwardsymbol = "ENO" + Right(tickersymbol, 5)
'
'begin interest rate loop
'
    For x = 1 To 10
    Worksheets("Data").Activate
    If Worksheets("Data").Cells(4 + x, 1) = Forwardsymbol Then InterestRate = Worksheets("Data").Cells(4 + x, 7)
    Next x
Worksheets("Salkku").Cells(7 + i, 6) = InterestRate
'
'update forward price
'
    Forwardsymbol = Right(tickersymbol, 5)
    If Left(Forwardsymbol, 1) = "Y" Then Forwardtype = "Nordpool - vuosituotteet/"
    If Left(Forwardsymbol, 1) = "Q" Then Forwardtype = "Nordpool - kausituotteet/"
    Cells(7 + i, 8).Formula = "=(ert|'/" & Forwardtype + "ENO" & Forwardsymbol + "'!BestBid" + "+ert|'/" & Forwardtype + "ENO" & Forwardsymbol + "'!BestAsk)/2"
'
'begin expiry date loop
'
tickersymbol = Cells(7 + i, 1)
Forwardsymbol = "ENO" + Right(tickersymbol, 5)
    For x = 1 To 10
    Worksheets("Data").Activate
    If Worksheets("Data").Cells(4 + x, 1) = Forwardsymbol Then Expirydate = Worksheets("Data").Cells(4 + x, 4)
    Next x
Worksheets("Salkku").Cells(7 + i, 7) = Expirydate
'
'begin option price update loop
'
tickersymbol = Cells(7 + i, 1)
    Worksheets("Optiohinnat").Activate
    For x = 1 To 150
    If Worksheets("Optiohinnat").Cells(8 + x, 1) = tickersymbol Then Worksheets("Salkku").Cells(7 + i, 10) = _
    Worksheets("Optiohinnat").Cells(8 + x, 9)
    Next x
'
'end primary update loop
'
Next i
End Sub