'// Author's blog:
'// Heart of the Finance
'// http://heartofthefinance.blogspot.com/
'//
'// Black-Scholes Option Princing Model for dividend paying underlying assets VBA code (Premium and Greeks)
'// version 1.0.0
'// Last update: 1/15/2011
'****************************************************************************
'* Cumulative Standard Normal Distribution *
'* (This function provides similar result as NORMSDIST( ) on Excel) *
'****************************************************************************
Function SNorm(z)
c1 = 2.506628
c2 = 0.3193815
c3 = -0.3565638
c4 = 1.7814779
c5 = -1.821256
c6 = 1.3302744
If z > 0 Or z = 0 Then
w = 1
Else: w = -1
End If
y = 1 / (1 + 0.2316419 * w * z)
SNorm = 0.5 + w * (0.5 - (Exp(-z * z / 2) / c1) * _
(y * (c2 + y * (c3 + y * (c4 + y * (c5 + y * c6))))))
End Function
'**********************************************************************
'* Black-Scholes European Call Price Computation *
'**********************************************************************
Function Call_Eur(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
's: spot price of an underlying asset
'k: strike price
't: (T-t); time to maturity. i.e. T: maturity, t: current
'r: risk-free rate (annual rate, continuous compounding)
'q: dividend yield (annual rate, continuous compounding)
'sd:volatility (standard deviation of return) of an underlying asset
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Call_Eur = Exp(-q * t) * s * SNorm(d1) - k * Exp(-r * t) * SNorm(d2)
End Function
'*********************************************************************
'* Black-Scholes European Put Price Computation *
'*********************************************************************
Function Put_Eur(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
'Put-call parity
'Call_Eur_tmp = Exp(-q * t) * s * SNorm(d1) - k * Exp(-r * t) * SNorm(d2)
'Put_Eur = -s * Exp(-q * t) + Call_Eur_tmp + k * Exp(-r * t)
Put_Eur = k * Exp(-r * t) * (1 - SNorm(d2)) - s * Exp(-q * t) * (1 - SNorm(d1))
End Function
'**********************************************************************
'* Black-Scholes European Call Delta Computation *
'**********************************************************************
Function Call_Eur_Delta(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Call_Eur_Delta = Exp(-q * t) * SNorm(d1)
End Function
'*********************************************************************
'* Black-Scholes European Put Delta Computation *
'*********************************************************************
Function Put_Eur_Delta(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Put_Eur_Delta = -Exp(-q * t) * (1 - SNorm(d1))
End Function
'**********************************************************************
'* Black-Scholes European Call Gamma Computation *
'**********************************************************************
Function Call_Eur_Gamma(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Call_Eur_Gamma = Exp(-q * t) / (s * sd * t ^ 0.5) * Exp(-d1 ^ 2 / 2) / (2 * Application.WorksheetFunction.Pi()) ^ 0.5
End Function
'**********************************************************************
'* Black-Scholes European Put Gamma Computation *
'**********************************************************************
Function Put_Eur_Gamma(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Put_Eur_Gamma = Exp(-q * t) / (s * sd * t ^ 0.5) * Exp(-d1 ^ 2 / 2) / (2 * Application.WorksheetFunction.Pi()) ^ 0.5
End Function
'**********************************************************************
'* Black-Scholes European Call Vega Computation *
'**********************************************************************
Function Call_Eur_Vega(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Call_Eur_Vega = Exp(-q * t) * s * (t ^ 0.5) * Exp(-d1 ^ 2 / 2) / (2 * Application.WorksheetFunction.Pi()) ^ 0.5
End Function
'**********************************************************************
'* Black-Scholes European Put Vega Computation *
'**********************************************************************
Function Put_Eur_Vega(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Put_Eur_Vega = Exp(-q * t) * s * (t ^ 0.5) * Exp(-d1 ^ 2 / 2) / (2 * Application.WorksheetFunction.Pi()) ^ 0.5
End Function
'**********************************************************************
'* Black-Scholes European Call Theta Computation *
'**********************************************************************
Function Call_Eur_Theta(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Call_Eur_Theta = q * Exp(-q * t) * s * SNorm(d1) - Exp(-q * t) * s * sd / (2 * (t) ^ 0.5) * Exp(-d1 ^ 2 / 2) / (2 * Application.WorksheetFunction.Pi()) ^ 0.5 - k * r * Exp(-r * t) * SNorm(d2)
End Function
'**********************************************************************
'* Black-Scholes European Put Theta Computation *
'**********************************************************************
Function Put_Eur_Theta(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Put_Eur_Theta = q * Exp(-q * t) * s * (-1) * SNorm(-d1) - Exp(-q * t) * s * sd / (2 * (t) ^ 0.5) * Exp(-d1 ^ 2 / 2) / (2 * Application.WorksheetFunction.Pi()) ^ 0.5 + k * r * Exp(-r * t) * SNorm(-d2)
End Function
'**********************************************************************
'* Black-Scholes European Call Rho Computation *
'**********************************************************************
Function Call_Eur_Rho(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Call_Eur_Rho = k * t * Exp(-r * t) * SNorm(d2)
End Function
'**********************************************************************
'* Black-Scholes European Put Rho Computation *
'**********************************************************************
Function Put_Eur_Rho(s, k, t, r, q, sd)
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / k)
b = (r - q + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Put_Eur_Rho = -k * t * Exp(-r * t) * SNorm(-d2)
End Function
|