I'm new to VBA and I'm currently trying to simulate M paths of GBM(Geometric Brownian motions) in VBA. I know this can be done with excel, but I would still like to know how we can get this done in VBA for my personal knowledge. Here is my code:
Sub test()
Dim dt As Double, T As Integer, N As Integer, M As Integer, S As Double, mu As Double _
, sig As Double, drift As Double, diff As Double, i As Integer, j As Integer
mu = 0.15
sig = 0.2
T = 1
N = 365
M = 100
S = 150.5
dt = T / N
Dim mat() As Variant
ReDim mat(1 To M, 1 To (N + 1)) As Variant
For i = 1 To UBound(mat)
mat(i, 1) = S
Next
For i = 1 To M
For j = 2 To (T + 1)
drift = (mu + 0.5 * sig^(2)) * dt
diff = Sqr(dt) * WorksheetFunction.Norm_Inv(Rnd, 0, 1)
mat(i, j) = mat(i, j - 1) * Exp(drift + diff)
Next
Next
End Sub
First issue
My equations seem to be correct. The main issue that I'm having is with variable types. For instance, I get an overflow error when assigning the value 0.15 to mu, 0.2 to sig (mu = 0.15, sig = 0.2, etc.). I don't really understand why I get that error since mu and sig are defined as doubles, just like the values that I want to assign to them (0.15 and 0.20).
Second issue
A non-efficient way to get around my first issue is to declare all variables as variants. Even when all my variables are declared as variants, my second loop does not run.
Here is my second loop:
For i = 1 To M
For j = 2 To (T + 1)
drift = (mu + 0.5 * sig^(2)) * dt
diff = Sqr(dt) * WorksheetFunction.Norm_Inv(Rnd, 0, 1)
mat(i, j) = mat(i, j - 1) * Exp(drift + diff)
Next
Next
More specifically, I get the same overflow error when i try to assign a value to a specific element of my array (i.e. mat(i, j) = mat(i, j - 1) * Exp(drift + diff)).
Does anyone know how I can solve those issues?
Note that I'm using the latest VBA version for Macbook.
With VBA 7.1 (Windows), I made it work with adding some space in your exponent formula ( sig ^ (2) ):
For i = 1 To M
For j = 2 To (T + 1)
drift = (mu + 0.5 * sig ^ (2)) * dt
diff = Sqr(dt) * WorksheetFunction.Norm_Inv(Rnd, 0, 1)
mat(i, j) = mat(i, j - 1) * Exp(drift + diff)
Debug.Print mat(i, j)
Next
Next
I don't see any problem with double type, you're right.
No overflow error...
Related
Dim i As Double
Dim x As Double
Dim y As Integer
Dim araba As Integer
Dim n As Integer
Dim bobin As Integer
Dim iplik As Integer
n = Sheets("kaynak").Cells(21, 1)
bobin = ((630 - n) / 2)
Dim j As Integer
For j = 1 To 10
iplik = Sheets("kaynak").Cells(j, 1)
For i = bobin To bobin + iplik
If i <= 315 Then
x = 7 - Int(i / 45) 'kaçıncı satır'
y = 45 - (i Mod 45)
Sheets("front").Cells(x, y) = Sheets("kaynak").Cells(j, 2)
Else
If i = 630 Then
x = 7
Else
x = Int(i / 45) - 6
End If
y = 46 - (i Mod 45)
Sheets("arka").Cells(x, y) = Sheets("kaynak").Cells(j, 2)
End If
Next i
bobin = bobin + iplik
Next j
my problem is at the title actually i want to print values to "arka" but it does just to "front" it works truely for front but doesn't go for further and i stopts at 315 ,i got error 1004 application defined or object defined error
When i = 315 (the last pass when i <= 315) then
x = 7 - Int(i / 45) 'kaçıncı satır'
gives x the value 0, since 315/45 = 7 exactly.
This causes the line
Sheets("front").Cells(x, y) = Sheets("kaynak").Cells(j, 2)
to error-out. You never progress beyond that line in that pass through the loop. Thus your code never even attempts to write to sheet "arka".
Perhaps replacing the line
x = 7 - Int(i / 45)
with
x = Application.Max(1,7 - Int(i / 45))
will fix the error.
How should I answer this-"Compute the total number of possible paths from (0,0) to (7,9) if the steps R (to the right) and U (up) are allowed, along with the diagonal step D:(x,y)→(x +1,y+ 1)"
Edit: added calculation for arbitrary cell, not only diagonal one.
The number of ways on square grid is known as Delannoy number, for (n,n) cell sequence is 1, 3, 13, 63, 321, 1683, 8989...
There is simple natural recurrence
D(m, n) = D(m-1, n) + D(m, n-1) + D(m-1,n-1)
that might be used to calculate values rather quickly for reasonable argument values (table approach, O(nm) operations including long summation).
"Closed formula"
D(m, n) = Sum[k=0..min(n, m)] {C(m + n - k, m) * C(m, k)}
for effective implementations requires table of binomial coefficients
#2D table quadratic approach
def PathsInSqGrid(n, m):
D = [[0 for x in range(m+1)] for y in range(n+1)]
for i in range(n+1):
D[i][0] = 1
for i in range(m+1):
D[0][i] = 1
for i in range(1, n+1):
for j in range(1,m+1):
D[i][j] = D[i][j-1] + D[i-1][j] + D[i-1][j-1]
return D[n][m]
def NCr(n, k):
result = 1
if k > n - k:
k = n - k
for i in range (1, k + 1):
result = (result * (n - i + 1)) // i
return result
#closed formula
def PathsCF(n, m):
#D(m, n) = Sum[k=0..min(n, m)] {C(m + n - k, m) * C(m, k)}
res = 0
for k in range(0, min(n, m) + 1):
res += NCr(m + n - k, m) *NCr(m, k)
return res
print(PathsInSqGrid(7, 9))
print(PathsCF(7, 9))
>>>
224143
224143
Wiki also shows two so-called "closed formulas" for central Delannoy numbers (while I believe that closed formula should be single expression without loop of length n):
D(n) = Sum[k=0..n]{C(n,k)*C(n+k,k)}
D(n) = Sum[k=0..n]{C(n,k)^2 * 2^n}
and recurrence (looks simple, linear complexity, but real implementation requires division of long number by short one)
n*D(n) = 3*(2*n-1) * D(n-1) - (n-1)*D(n-2)
and generating function
Sum[n=0..Inf]{D(n)*x^n} = 1/Sqrt(1 - 6 * x + x^2) = 1 + 3x + 13x^2 + 63x^3 +...
Code
#central Delannoy numbers
#2D table quadratic approach
#linear approach for diagonal cell (n,n)
def PathsInSqGridLin(n):
if n < 2:
return 2 * n + 1
A, B = 1, 3
for i in range(2, n + 1):
B, A = (3 * (2 * i - 1) * B - (i - 1) * A) // i, B
return B
print(PathsInSqGridLin(3))
print(PathsInSqGridLin(100))
>>
63
2053716830872415770228778006271971120334843128349550587141047275840274143041
I am trying to calculate velocity and acceleration, with the variable being the time t. I'd like to write these in vba, to make it faster, because later on I'll need velocity and acceleration for several other calculations combined with different logical conditions. I would like the results to be printed in the worksheet, to double check during calculation if the results are realistic.
example of how it should like more or less
t vel a
0.002 39 -777
0.004 38.6 -802
0.006 35 -500
0.008 33.4 -400
0.01 32.1 -12297.1
So I have tried a few different things based on comments:
This first code example works fine I think from the results, but I still can see any of the results in between > so main question: any chance I can change the commend to write to the worksheet without changing much else?
The second code example is an attempt to write everything into arrays: I do understand the principle I think, but here the main error seems to be that my variable t is not getting generated properly and therefore the formulas are not calculated: can't find the mistakes here and I would be grateful for some more help...
Kinematics Calculation
'Set t from 0 to 2 s with time step of 0.002s; Calculate Rot_vel until <= 0,
'Find index t_2 when Rot_vel <= 0
t = 0
Do
t = t + 0.002
Rot_vel = -10356# * t ^ 6 + 24130# * t ^ 5 - 19002# * t ^ 4 + 4933# * t ^ 3 +
362# * t ^ 2 - 213# * t + 39
Worksheets("test").Range(Cells(3, 2), Cells(1003, 2)) = Rot_vel
Loop Until Rot_vel <= 0
If Rot_vel <= 0 Then
t_2 = t
If t_2 > 0 Then
Debug.Print t_2
End If
End If
'Continue calculations for t 0 to t_2 with 0.002 steps
t = 0
Do
t = t + 0.002
A_rot = -62136# * t ^ 5 + 120650# * t ^ 4 - 76008# * t ^ 3 + 14797.8 * t
^ 2 + 723.26 * t - 212.7
Worksheets("test").Range(Cells(3, 3), Cells(1003, 3)).value = A_rot
L = MoI * Rot_vel / 1000
M = MoI * A_rot / 1000
Worksheets("test").Range(Cells(3, 8), Cells(1003, 8)).value = L
Worksheets("test").Range(Cells(3, 9), Cells(1003, 9)).value = M
G = L / t_2
Worksheets("test").Range(Cells(3, 10), Cells(1003, 10)).value = G
Loop Until t = t_2
Second version:
Kinematics Calculation
'Set t from 0 to 2 s with time step of 0.002s; Calculate Rot_vel until <= 0,
'Find index t_2 when Rot_vel <= 0
Dim arrCalc As Variant
Dim i As Integer
Dim j As Integer
ReDim arrCalc(i To 1003, j To 13)
For i = LBound(arrCalc, 2) To UBound(arrCalc, 2)
t = 0
Do
t = t + 0.002
arrCalc(i, 1) = t
arrCalc(i, 2) = -10356# * t ^ 6 + 24130# * t ^ 5 - 19002# * t ^ 4 + 4933#
* t ^ 3 + 362# * t ^ 2 - 213# * t + 39 'Rot_vel
Loop Until arrCalc(i, 2) < 0
Dim pos, val
val = 0
pos = Application.Match(val, arrCalc(i, 2), False)
pos = t_2
t = 0
Do
t = t + 0.002
arrCalc(i, 3) = -62136# * t ^ 5 + 120650# * t ^ 4 - 76008# * t ^ 3 +
14797.8 * t ^ 2 + 723.26 * t - 212.7
arrCalc(i, 8) = MoI * Rot_vel / 1000 'L
arrCalc(i, 9) = MoI * A_rot / 1000 'M
arrCalc(i, 10) = 1 / t_2 * L 'G
Loop Until t = t_2
Next i
With Worksheets("test")
.Cells(2, "A") = 0
.Cells(3, "A").Resize(UBound(arrCalc, 1), UBound(arrCalc, 2)) = Rot_vel
.Cells(2, "A").Resize(UBound(arrCalc, 1) + 1, 1) = t
'.Cells(3, "C").Resize(UBound(arrCalc, 1), UBound(arrCalc, 3)) = A_rot
End With
Your variables a_rot and rot_val don't look to me like arrays but normal variables. Therefore, only one value is stored in them and of course you get only one value as an output.
I see two options: 1) You write all of your values into an array and then copy the array to the sheet. 2) You write each calculation line by line to the sheet. Number 1) is much much faster.
A solution could look something like this:
ReDim Array (Lines, Columns)
For each line
Array (line, Columns1) = Formula1
Array (line, Columns2) = Formula2
Array (line, Columns3) = Formula3
Next
Build a 2-D array with times and calculations then dump the results back onto the worksheet.
Sequential time is very prone to 15 significant digit floating point errors. These errors can be minimized with a form of datum dimensioning that creates all new entries relative to the original starting point instead of the previous value. The former method can have no error greater than a single calculation while the latter can compounding errors by carrying them into the next calculation.
Sub kinematicsCalculation()
Dim t As Double, start As Double, i As Long, arr As Variant
start = TimeSerial(0, 0, 0) 'start at 0 second mark
ReDim arr(1 To 1000, 1 To 2)
For i = LBound(arr, 1) To UBound(arr, 1)
arr(i, 1) = start + TimeSerial(0, 0, 2 * i) / 1000
'cannot attempt velocity calc without Rot_vel_i
arr(i, 2) = "<velocity calculation here>"
Next i
With Worksheets("sheet")
.Cells(2, "B") = start
.Cells(3, "B").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
.Cells(2, "B").Resize(UBound(arr, 1) + 1, 1).NumberFormat = "[hh]:mm:ss.000"
End With
End Sub
I keep getting the invalid procedure call or argument error on the definition of sigma2d line.
Any idea how to avoid this code error?
Private Sub CommandButton4_Click()
Application.Range("E19").value = ""
Application.Range("F19").value = ""
S0 = Application.Range("C5").value 'arithmetic average of underlying 1
K = Application.Range("C6").value 'strike
T = Application.Range("C10").value 'maturity
sigma = Application.Range("C8").value 'volatility
r = Application.Range("C8").value 'risk free rate
nsteps = Application.Range("C12").value 'no of timesteps
nsimulations = Application.Range("C13").value ' no of mc simulations
div = Application.Range("C9").value 'dividends
Randomize
Dim M1 As Double, M2 As Double, sigma2d As Double
Dim d1 As Double, d2 As Double, Nd1 As Double, Nd2 As Double
M1 = (Exp((r - div) * T) - 1) / (r - div) * T
v = (2 * Exp((2 * r) - (2 * div) + (sigma * sigma) * T)) * S0 * S0
w = (r - div + (sigma * sigma)) * (2 * r - 2 * q + (sigma * sigma)) * T * T
Z = 2 * S0 * S0 / ((r - div) * T * T)
y = (1 / 2 * (r - div) + sigma * sigma)
h = Exp((r - div) * T) / (r - div + (sigma * sigma))
M2 = (v / w) + Z * (y - h)
M3 = M1 * M1
sigma2d = Log(M2 / M3)
d1 = (Log(M1 / K) + (sigma2d * T) / 2) / sigma * Sqr(T)
d2 = d1 - sigma * Sqr(T)
callArith = Exp(-r * T) * (M1 * Nd1 - K * Nd2)
Application.Range("E19").value = Application.Max(ExactCall, 0)
Are you trying to do the log of a negative number? Set a breakpoint and check variables before that line. Maybe you have an error before that generating a negative.
First check the argument to the Log function is positive.
Failing that, it could be due to a missing reference in the project. This manifests itself in this curious way. Have a look at "Tools", "References" and see if there is one missing.
You can write sigma2d = Vba.Log(M2 / M3) instead but that's only really a short fix since missing references will cause you headaches elsewhere.
One more thing, why not create a function instead, passing in all the variables as function parameters? Your spreadsheet will be more stable if you do that.
(Also, at the end of your code, d1 definition is incorrect. You need brackets around sigma * Sqr(T)).
I think you need a pair of () or do "/T" as you are multiplying by T here:
M1 = (Exp((r - div) * T) - 1) / (r - div) * T
I am new to VBA programming and am trying to develop a simple code for RCC design. Most of the values are assigned directly from the excel sheet. I am getting this error that says "division by zero".The line within ** ** is highlighted while debugging. it seems there is some problem with declaration or looping but i am not being able to identify. Pls help. Thanx in advance. The code is as follows:
Private Sub CommandButton1_Click()
Dim a As Double, b As Double, result As String, Mu As Double
Dim i As Integer, j As Integer, c As Integer, Xu1, Xu, es, d, f, fs As Double
Dim strain1(1 To 6) As Double, stress1(1 To 6) As Double
a = Range("E30").Value
b = Range("O30").Value
If a < b Then
result = "Under Reinforced Section"
Mu = Range("E32").Value * Range("E34").Value
ElseIf a = b Then
result = "Balanced Secction"
Mu = Range("E32").Value * Range("E34").Value
ElseIf a > b Then
result = "Over Reinforced Section"
j = 31
For i = 1 To 6
strain1(i) = Cells(j, 7)// loop to assign values in array from excel sheet
j = j + 1
Next
j = 31
For i = 1 To 6
stress1(i) = Cells(j, 8)
j = j + 1
Next
c = 1
Xu1 = Range("O30").Value
d = Range("E31").Value
Do While c = 1
Xu = Xu1
**es = 0.0035 * (d - Xu) / (Xu)**// Shows error apparently Xu is taking value zero
If Range("E22").Value = 250 Then
fs = es * Range("E23").Value
f = 0.87 * Range("E22").Value
If fs > f Then
fs = f
End If
ElseIf Range("E22").Value = 415 Then
f = 0.696 * Range("E22").Value / Range("E23").Value
If es > f Then
For i = 1 To 6
If es > strain1(i) And es < strain1(i + 1) Then// to locate es in the array and then interpolate
fs = stress1(i) + ((stress1(i + 1) - stress1(i)) / (strain1(i + 1) - strain1(i))) * (es - strain1(i))// linear interpolation formulae
End If
Next
ElseIf es < f Then
fs = es * Range("E23").Value
End If
Xu1 = Range("O29").Value * fs / (0.36 * Range("E21").Value * Range("E16").Value)
If Xu1 = Xu Then
c = 0
End If
Mu = 0.36 * Range("E21").Value * Range("E16").Value * Xu1 * Range("E34").Value
End If
Loop
End If
Range("O21").Value = Mu
MsgBox result
End Sub
strain1(1 To 6) has 6 elements 1 to 6, for i=6 you're trying to access a 7th element (strain1(i + 1)) in the highlighted row. (the same holds true for stress1 in the next line)