Black Scholes VBA module

black-scholes.vb

Option Explicit

Private Function n(strike As Double, s As Double, sd As Double, r As Double, days As Double) As Double
  Dim ls, lx, sd2, t As Double
  ls = Log(s)
  lx = Log(strike)
  t = days / 365
  sd2 = pow(sd, 2)
  n = ls - lx + r * t + sd2 * t / 2
End Function

Function bsdelta(strike As Double, s As Double, sd As Double, r As Double, days As Double) As Double
    Dim nn, sqT, d, d1 As Double
    nn = n(strike, s, sd, r, days)
    sqT = sqrt(days / 365)
    d = sd * sqT
    d1 = nn / d
    bsdelta = normaldist(d1)
End Function

Private Function delta2(n As Double, sd As Double, days As Double) As Double
    Dim sqT, d, d1 As Double
    sqT = sqrt(days / 365)
    d = sd * sqT
    d1 = n / d
    delta2 = normaldist(d1)
End Function

Private Function nd2(n As Double, sd As Double, days As Double)
  Dim sqrtT, d, d1, d2 As Double
  sqrtT = sqrt(days / 365)
  d = sd * sqrtT
  d1 = n / d
  d2 = d1 - sd * sqrtT
  nd2 = normaldist(d2)
End Function

Function bond(strike As Double, s As Double, sd As Double, r As Double, days As Double) As Double
    Dim nn, t, nd1, nnd2 As Double
    nn = n(strike, s, sd, r, days)
    t = days / 365
    nd1 = delta2((nn), sd, days)
    nnd2 = nd2((nn), sd, days)
    bond = -strike * Exp(-r * t) * nnd2
End Function

Function callvalue(strike As Double, s As Double, sd As Double, r As Double, days As Double) As Double
    Dim nn, t, nd1, b As Double
    nn = n(strike, s, sd, r, days)
    t = days / 365
    nd1 = delta2((nn), sd, days)
    b = bond(strike, s, sd, r, days)
    callvalue = s * nd1 + b
End Function


Function putvalue(strike As Double, s As Double, sd As Double, r As Double, days As Double) As Double
    Dim t, callv As Double
    t = days / 365
    callv = callvalue(strike, s, sd, r, days)
    putvalue = strike * Exp(-r * t) - s + callv
End Function

Private Function sqrt(v As Double) As Double
  sqrt = v ^ 0.5
End Function

Private Function pow(a As Double, b As Double) As Double
  pow = a ^ b
End Function

Function normaldist(zz As Double) As Double
    'cdf of 0 is 0.5
    If (zz = 0) Then
      normaldist = 0.5
      Exit Function
    End If
    
    Dim z As Double

    z = zz  'zz is input variable,  use z for calculations
    If (zz < 0) Then
        z = -zz  'change negative values to positive
    End If
    
    Dim p, b1, b2, b3, b4, b5 As Double
    'set constants
    p = 0.2316419
    b1 = 0.31938153
    b2 = -0.356563782
    b3 = 1.781477937
    b4 = -1.821255978
    b5 = 1.330274428
    
    Dim f, ff, s1, s2, s3, s4, s5 As Double
    Dim M_PI As Double
    M_PI = 3.14159
    'CALCULATIONS
    f = 1 / sqrt(2 * M_PI)
    ff = Exp(-pow(z, 2) / 2) * f
    s1 = b1 / (1 + p * z)
    s2 = b2 / pow((1 + p * z), 2)
    s3 = b3 / pow((1 + p * z), 3)
    s4 = b4 / pow((1 + p * z), 4)
    s5 = b5 / pow((1 + p * z), 5)
    
     Dim sz As Double
    'sz is the right-tail approximation
     sz = ff * (s1 + s2 + s3 + s4 + s5)

    If (zz < 0) Then
      'cdf of negative input is right-tail of input's absolute value
      normaldist = sz
    Else
      'cdf of positive input is one minus right-tail
       normaldist = (1 - sz)
    End If

End Function