While running this code to randomize some values I find that the all the cells have the same number. I believe I'm missing a standard concept but I can't seem to wrap my head around the issue.
Randomize
LWeekDay = Int((400 - 150 + 1) * Rnd + 200)
LWeekEnd = Int((600 - 200 + 1) * Rnd + 200)
For Y = 3 To 10
For X = 2 To 8
Cells(Y, X) = LWeekDay
Next X
Next Y
You are currently only calculating LWeekDay once, and then using that value for every cell.
I assume you want to assign a new value every time through the loop:
Randomize
For Y = 3 To 10
For X = 2 To 8
LWeekDay = Int((400 - 150 + 1) * Rnd + 200)
LWeekEnd = Int((600 - 200 + 1) * Rnd + 200)
Cells(Y, X) = LWeekDay
Next X
Next Y
Related
So I have a "main" function (SolveSixODES) that calls a secondary function (AllODEs). And when it does this, the x value in the main function gets modified. I don't understand how this can be possible, seeing as it is not a global variable.
Here is the code, my inputs I used are as follows:
x=0, xmax=3, y=0-6, h=0.1, error=0.1
Public Function SolveSixODE(x As Double, xmax As Double, Y As Range, h As Double, error As Double) 'Weird bug: You must leave the first y4 value blank
Dim i As Integer, k(7, 7) As Double, j As Integer, m As Integer 'k(Order #, equation #)
Dim Y5(7) As Double, Y4(7) As Double, Y4Old(7) As Double
Dim delta0(7) As Double, delta1(7) As Double, delRatio(7) As Double, Rmin As Double
For i = 1 To 6 'Moving the input data so it can acutally be used
Y4(i) = Y(i)
Next i
While x < xmax
If x + h < xmax Then
x = x + h
Else
h = xmax - x
x = xmax
End If
For j = 1 To 6 'j is the order i is equation number
For i = 1 To 6 'Calculating all of the k(1) values for eq 1 to 6
k(j, i) = AllODES(x, Y4, i, j, k, h) '!!!!!SOME HOW THIS LOOP MAKES X negative...!!!!!!!
Next i
Next j
For i = 1 To 6
Y4Old(i) = Y4(i) 'Saving old y4 value to calc delta0
Y4(i) = Y4(i) + h * (k(1, i) * (37 / 378) + k(3, i) * (250 / 621) + k(4, i) * (125 / 594) + k(6, i) * (512 / 1771))
Y5(i) = Y4(i) + h * (k(1, i) * (2825 / 27648) + k(3, i) * (18575 / 48384) + k(4, i) * (13525 / 55296) + k(5, i) * (277 / 14336) + k(6, i) * (0.25))
delta0(i) = error * (Abs(Y4Old(i)) + Abs(h * AllODES(x, Y4Old, i, 1, k, h))) 'First order because we don't want to use the k vals
delta1(i) = Abs(Y5(i) - Y4(i))
delRatio(i) = Abs(delta0(i) / delta1(i)) 'Ratio of errors
Next i
Rmin = delRatio(1)
For i = 2 To 6
If delRatio(i) < Rmin Then
Rmin = delRatio(i) 'Determine the smallest error ratio
End If
Next i
If Rmin < 1 Then 'If this is true then the step size was too big must repeat step
x = x - h 'Set x and y's back to previous values
For i = 1 To 6
Y4(i) = Y4Old(i)
Next i
h = 0.9 * h * Rmin ^ 0.25 'adjust h value; 0.9 is a safety factor
Else
h = 0.9 * h * Rmin ^ 0.2 'Otherwise, we march on
End If
m = m + 1
Wend
SolveSixODE = Y4
End Function
Public Function AllODES(x As Double, Y() As Double, EqNumber As Integer, order As Integer, k() As Double, h As Double) As Double
Dim conc(7) As Double, i As Integer, j As Integer
If order = 1 Then
x = x - h
For i = 1 To 6 'Movin the data so I can use it
conc(i) = Y(i) 'also adjusting the x and y values for RK4 (Cash Karp values)
Next i
ElseIf order = 2 Then
x = x - h + h * 0.2
For i = 1 To 6
conc(i) = Y(i) + h * k(1, i) * 0.2
Next i
ElseIf order = 3 Then
x = x - h + 0.3 * h
For i = 1 To 6
conc(i) = Y(i) + h * (0.075 * k(1, i) + 0.225 * k(2, i))
Next i
ElseIf order = 4 Then
x = x - h + 0.6 * h
For i = 1 To 6
conc(i) = Y(i) + h * (0.3 * k(1, i) - 0.9 * k(2, i) + 1.2 * k(3, i))
Next i
ElseIf order = 5 Then
x = x - h + h
For i = 1 To 6
conc(i) = Y(i) + h * ((-11 / 54) * k(1, i) + 2.5 * k(2, i) - (70 / 27) * k(3, i) + (35 / 27) * k(4, i))
Next i
ElseIf order = 6 Then
x = x - h + 0.875 * h
For i = 1 To 6
conc(i) = Y(i) + h * ((1631 / 55296) * k(1, i) + (175 / 512) * k(2, i) + (575 / 13824) * k(3, i) + (44275 / (110592) * k(4, i) + (253 / 4096) * k(5, i)))
Next i
Else
MsgBox ("error")
End If
If EqNumber = 1 Then 'These are the actual equations
AllODES = x + Y(1)
ElseIf EqNumber = 2 Then
AllODES = x
ElseIf EqNumber = 3 Then
AllODES = Y(3)
ElseIf EqNumber = 4 Then
AllODES = 2 * x
ElseIf EqNumber = 5 Then
AllODES = 2 * Y(2)
ElseIf EqNumber = 6 Then
AllODES = 3 * x
Else
MsgBox ("You entered an Eq Number that was dumb")
End If
End Function
It's possible that it is something really trivial that I missed but this seems to contradict my knowledge of how variables work. So if you understand how the function is able to manipulate a variable from another function in this case, I would appreciate any advice and/or explanation!
Thanks in advance!
the x value in the main function gets modified. I don't understand how this can be possible, seeing as it is not a global variable
This is normal because you are passing x by reference to the function AllODES and you do change it there. When the keyword ByVal is not explicitly specified in the function/sub prototype, the default passing mechanism is ByRef, that is, by reference.
Public Function AllODES(x As Double, ...
means
Public Function AllODES(ByRef x As Double, ....
We observe that x is manipulated in this function, so the change will appear in the caller. If you want that the change of x does not report back in the caller's scope, pass x by value:
Public Function AllODES(ByVal x As Double, ....
' ^^^^^
Only in this case the x of the caller and the x of the callee will be two different variables.
This code doesn't find the correct output
for say n= 1 (although it gives the correct output for say n= 2,3,4..etc.)
if we put n= 1 to find x then the i loop will continue from 1 to 0, hence the first term in x should vanish and leftover should be the second term 5; but it gives 0 ?
Is there any limitation on the input n to run the for loop ?I would appreciate any help.
Function math(n As Integer) As Double
Dim i As Integer
Dim x As Double
For i = 1 To n - 1
x = (n - 1) * 2 + 5
sum = sum + x
Next i
math = sum
End Function
Why not simply:
Function math(n As Integer) As Double
Math = ((n - 1) * 2 + 5) * Abs((n - 1) - (n = 1))
End Function
???
if the answer is correct then Math = (n * 2 + 3) * Abs((n - 1) - (n = 1)) would be easier to understand and make much more sense
In the for loop, if you don't precise the Step, the variable will only increment by 1.
And here, you start at 1 to go to 0, so the loop won't execute, you need to test n to cover both cases :
Function math(n As Integer) As Double
If n < 0 Then Exit Function
Dim i As Integer
Dim x As Double
Dim Summ As Double
Select Case n
Case Is > 1
For i = 1 To n - 1
x = (i - 1) * 2 + 5
Summ = Summ + x
Next i
Case Is = 1
Summ = (n - 1) * 2 + 5
Case Is = 0
Summ = 5
Case Else
MsgBox "This case is not supported", vbInformation + vbOKOnly
Exit Function
End Select
math = Summ
End Function
If n = 1, you end up with For i = 1 To 0 which is incorrect and
should be expressed For i = 1 To 0 STEP -1.
So I suggest you add the STEP BYand make sure it is either 1 to -1 depending on N.
I have issue with an Excel worksheet that contains the formula:
=Spline($D$9:$D$34,$J$9:$J$34,$D43)
Sheet works fine until I open this sheet on network drive and save it on local drive. Then this formula throws #NAME? error. Strange is, that error is gone when I click on line with formula to edit it and press enter (nothing changes in formula).
Have someone met similar issue?
I just found another information. Formula spline is defined in VBA module, not internal in Excel. It looks like. But issue is still here.
Function spline(periodcol As Range, ratecol As Range, x As Range)
Dim period_count As Integer
Dim rate_count As Integer
period_count = periodcol.Rows.Count
rate_count = ratecol.Rows.Count
If period_count <> rate_count Then
spline = "Error: Range count does not match"
GoTo endnow
End If
ReDim xin(period_count) As Single
ReDim yin(period_count) As Single
Dim c As Integer
For c = 1 To period_count
xin(c) = periodcol(c)
yin(c) = ratecol(c)
Next c
Dim n As Integer
Dim i, k As Integer
Dim p, qn, sig, un As Single
ReDim u(period_count - 1) As Single
ReDim yt(period_count) As Single
n = period_count
yt(1) = 0
u(1) = 0
For i = 2 To n - 1
sig = (xin(i) - xin(i - 1)) / (xin(i + 1) - xin(i - 1))
p = sig * yt(i - 1) + 2
yt(i) = (sig - 1) / p
u(i) = (yin(i + 1) - yin(i)) / (xin(i + 1) - xin(i)) - (yin(i) - yin(i - 1)) / (xin(i) - xin(i - 1))
u(i) = (6 * u(i) / (xin(i + 1) - xin(i - 1)) - sig * u(i - 1)) / p
Next i
qn = 0
un = 0
yt(n) = (un - qn * u(n - 1)) / (qn * yt(n - 1) + 1)
For k = n - 1 To 1 Step -1
yt(k) = yt(k) * yt(k + 1) + u(k)
Next k
Dim klo, khi As Integer
Dim h, b, a As Single
klo = 1
khi = n
Do
k = khi - klo
If xin(k) > x Then
khi = k
Else
klo = k
End If
k = khi - klo
Loop While k > 1
h = xin(khi) - xin(klo)
a = (xin(khi) - x) / h
b = (x - xin(klo)) / h
y = a * yin(klo) + b * yin(khi) + ((a ^ 3 - a) * yt(klo) + (b ^ 3 - b) * yt(khi)) * (h ^ 2) / 6
spline = y
endnow:
End Function
Try to add:
Application.Volatile
to your VBA code. Add this just below the Function statement to force a renewed calculation as soon as anything changes.
I was running tests on my software today and found that some of the values it was producing weren't correct.
I decided to step through the code and noticed that the variables I had assigned to textbox values on my userform when hovered over said empty, even though when hovering over the textbox assigned to it, the value inputted by the user showed.
For Example,
n = BiTimeSteps_TextBox.Value
when hovered over
n = empty
even though
BiTimeSteps_TextBox.Value = 2
when hovered over.
So say I have a formula shortly after that says
d = n*2 ,
n when hovered over says empty and d is made 0 when it shouldn't be.
Someone told me if I switch it around to
BiTimeSteps_TextBox.Value = n
it should be recognised but it is still not.
What could possibly be causing this?
See full code below: (it aims to price options using the binomial tree pricing method)
S = BiCurrentStockPrice_TextBox.Value
X = BiStrikePrice_TextBox.Value
r = BiRisk_Free_Rate_TextBox.Value
T = BiexpTime_TextBox.Value
Sigma = BiVolatility_TextBox.Value
n = BiTimeSteps_TextBox.Value
Dim i, j, k As Integer
Dim p, V, u, d, dt As Double
dt = T / n ' This finds the value of dt
u = Exp(Sigma * Sqr(dt)) 'formula for the up factor
d = 1 - u 'formula for the down factor
'V value of option
'array having the values
Dim bin() As Double 'is a binomial arrays, it stores the value of each node, there is a loop
'work out the risk free probability
p = (1 + r - d) / (u - d)
'probability of going up
ReDim bin(n + 1) As Double
'it redims the array, and n+1 is used because it starts from zero
'------------------------------------------------------------------------------------------------------------------------------
''European Call
If BiCall_CheckBox = True Then
For i = 0 To n 'payoffs = value of option at final time
bin(i + 1) = Application.WorksheetFunction.Max(0, (u ^ (n - i)) * (d ^ i) * S - X)
'It takes the max payoff or 0
Cells(i + 20, n + 2) = bin(i + 1) 'to view payoffs on the isolated column on the right
Next i
End If
'european put
If BiPut_CheckBox = True Then
For i = 0 To n 'payoffs = value of option at final time
bin(i + 1) = Application.WorksheetFunction.Max(0, X - (S * (u * (n - i)) * (d * i)))
' European Put- It takes the max payoff or 0
Cells(i + 20, n + 2) = bin(i + 1) 'to view payoffs on the isolated column on the right
Next i
End If
For k = 1 To n 'backward column loop
For j = 1 To (n - k + 1) 'loop down the column loop
bin(j) = (p * bin(j) + (1 - p) * bin(j + 1)) / (1 + r)
Cells(j + 19, n - k + 2) = bin(j)
'' print the values along the column, view of tree
Next j
Next k
Worksheets("Binomial").Cells(17, 2) = bin(1) ' print of the value V
BiOptionPrice_TextBox = bin(1)
First off, here's my code:
Sub SimulatePortfolio()
Dim lambda As Double
Dim num As Integer
Dim cycles As Long
Column = 12
q = 1.5
lambda = 0.05
cycles = 100000
Dim data(1 To 100000, 1 To 10) As Integer
Dim values(1 To 10) As Double
For i = 1 To 10
values(i) = 0
Next i
temp = lambda
For i = 1 To cycles
lambda = temp
num = 10
t = 0
Dim temps(1 To 10) As Integer
For k = 1 To 10
temps(k) = 1000
Next k
Do While (t < 10 And num > 0)
t = t + tsim(lambda, num)
For j = 1 To 10
If (j > t) Then
temps(j) = temps(j) - 50
End If
Next j
num = num - 1
If (num <= 0) Then
Exit Do
End If
lambda = lambda * q
Loop
For l = 1 To 10
values(l) = values(l) + temps(l)
data(i, l) = temps(l)
Next l
Next i
For i = 1 To 10
Cells(i + 1, Column) = values(i) / cycles
'Problem occurs on this line:
Cells(i + 1, Column + 1).Value = Application.WorksheetFunction.Var(Application.WorksheetFunction.Index(data, i, 0))
Next i
End Sub
Function tsim(lambda As Double, num As Integer) As Double
Dim v As Double
Dim min As Double
Randomize
min = (-1 / lambda) * Log(Rnd)
For i = 1 To (num - 1)
Randomize
v = (-1 / lambda) * Log(Rnd)
If (min > v) Then
min = v
End If
Next i
tsim = min
End Function
When I set the value for cycles to 10000, it runs fine without a hitch. When I go to 100000 cycles, it gets an Error 13 at the indicated line of code.
Having been aware that Application.Tranpose is limited to 65536 rows with variants (throwing the same error) I tested the same issue with Index
It appears that Application.WorksheetFunction.Index also has a limit of 65536 rows when working with variants - but standard ranges are fine
So you will need to either need to dump data to a range and work on the range with Index, or work with two arrays
Sub Test()
Dim Y
Dim Z
'works in xl07/10
Debug.Print Application.WorksheetFunction.Index(Range("A1:A100000"), 1, 1)
Y = Range("A1:A65536")
`works
Debug.Print Application.WorksheetFunction.Index(Y, 1, 1)
'fails in xl07/10
Z = Range("A1:A65537")
Debug.Print Application.WorksheetFunction.Index(Z, 1, 1)
End Sub