x = 0
Do Until x = Step
SrcVol = (Vol / DilPoints)
DilVol = Vol - SrcVol
Vol = 0.75 * Vol
Wb1.Sheets(1).Range("D4").Offset((2 * x) + k - 1, 0) = SrcVol
Wb1.Sheets(1).Range("D5").Offset((2 * x) + k - 1, 0) = DilVol
DilPoints = Range("D8").Offset(x, 0)
x = x + 1
Loop
Hello,
I am trying to offset this range in my VBA code and the DilPoints value gets lost after the offset. I have tried everything but the loop keeps dividing by zero after the first iteration of the loop. How do you make sure the value stays around and continues to collect data from other cells and not just default to zero. I have used the .Select and it makes the value go to -1.
Related
I have created a UDF to iterate an equation. The UDF is working fine. But, if the argument(s) is assigned zero or negative, say W = 0, then the excel freezes completely. I want to stop the execution of UDF or display errors if the argument(s) is zero or negative and prevent the file from freezing. Please help
Function myfunc(Q, W, n, s As Double) As Double
Dim Q_Cal As Double
' to initialize the loop
D = 0.001
Q_Cal = 0.001
While Q_Cal < Q
D = D + 0.001
Q_Cal = ((W * D) / n) * ((W * D) / (2 * D + W)) ^ (2 / 3) * s ^ 0.5
Wend
myfunc = Round(D, 3)
End Function
I am running a Do Until loop that is lowering the value in target cells, starting at .99, (x=.99) and then using those values to complete a calculation. I need this loop to stop if 1 of 2 conditions is met.
Calculated value is within 10% of the target.
OR
x = .75
If the calculation doesn't match the target, the loop will lower x by .005 and try again. But I want .75 to be the lower limit of x.
Do Until
(Workbooks("Group 4 Correlation Solver").Sheets("STRUCTURETOOL").Range("J23").Value * -1 >= Workbooks("Group 4 Correlation Solver").Sheets("STRUCTURETOOL").Range("U28").Value * 0.9 And Workbooks("Group 4 Correlation Solver").Sheets("STRUCTURETOOL").Range("J23").Value * -1 <= Workbooks("Group 4 Correlation Solver").Sheets("STRUCTURETOOL").Range("U28").Value * 1.1) Or (x = 0.75)
Deal_ID = VBA.Right(Workbooks("Weekly Option Update (Master).xlsm").Sheets("GDD Group").Cells(i, "G").Value, 7)
Sheets("Correlation").Range("E7").Value = x
Workbooks("Group 4 Correlation Solver").Sheets("Correlation").Range("F8").Value = x
Workbooks("Group 4 Correlation Solver").Sheets("Correlation").Range("C9").Value = x
Workbooks("Group 4 Correlation Solver").Sheets("Correlation").Range("D10").Value = x
Workbooks("Group 4 Correlation Solver").Sheets("STRUCTURETOOL").Calculate
x = x - 0.005
Workbooks("Weekly Option Update (Master).xlsm").Sheets("GDD Group").Cells(i, "H") = x + 0.005
Loop
My code might not be the most efficient but it does currently run. The issue is that it is not looking at the 2nd condition of the lower limit of x. It simply keeps going until the calculated value is within 10% of the target.
I apologize in advance for the code format. The block right beneath "Do Until" is the code in question with the "and" and "or".
Boy that's a mouthful! Extract local variables, there's no need to repeatedly dereference the same objects over and over and over every time!
Local variables make things much easier to debug, too.
Dim solverBook As Workbook
Set solverBook = Application.Workbooks("Group 4 Correlation Solver")
Dim weeklyOptionBook As Workbook
Set weeklyOptionBook = Application.Workbooks("Weekly Option Update (Master).xlsm")
Dim gddGroupSheet As Worksheet
Set gddGroupSheet = weeklyOptionBook.Worksheets("GDD Group")
Dim structureSheet As Worksheet
Set structureSheet = solverBook.Worksheets("STRUCTURETOOL")
Dim currentValue As Double
currentValue = structureSheet.Range("J23").Value ' CAUTION: possible type mismatch here
Dim targetValue As Double
targetValue = structureSheet.Range("U28").Value ' CAUTION: possible type mismatch here
Const threshold As Double = 0.1
Const limit As Double = 0.75
Dim correlationSheet As Worksheet
Set correlationSheet = solverBook.Worksheets("Correlation")
Do Until (currentValue * -1 >= targetValue * (1 - threshold) _
And currentValue * -1 <= targetValue * (1 + threshold)) _
Or x <= limit
Deal_Id = Right$(gddGroupSheet.Cells(i, "G").Value, 7)
correlationSheet.Range("E7,F8,C9,D10").Value = x
structureSheet.Calculate
gddGroupSheet.Cells(i, "H") = x
x = x - 0.005
currentValue = structureSheet.Range("J23").Value ' CAUTION: possible type mismatch here
targetValue = structureSheet.Range("U28").Value ' CAUTION: possible type mismatch here
Loop
Don't use = when dealing with floating points. Or x <= limit is probably the solution to your immediate problem.
I would just use an If to test the second condition:
x = 1
Do Until x = 0.75
if Workbooks("Group 4 Correlation Solver").Sheets("STRUCTURETOOL").Range("J23").Value * -1 >= Workbooks("Group 4 Correlation Solver").Sheets("STRUCTURETOOL").Range("U28").Value * 0.9 And Workbooks("Group 4 Correlation Solver").Sheets("STRUCTURETOOL").Range("J23").Value * -1 <= Workbooks("Group 4 Correlation Solver").Sheets("STRUCTURETOOL").Range("U28").Value * 1.1 then exit do
Deal_ID = VBA.Right(Workbooks("Weekly Option Update (Master).xlsm").Sheets("GDD Group").Cells(i, "G").Value, 7)
Sheets("Correlation").Range("E7").Value = x
Workbooks("Group 4 Correlation Solver").Sheets("Correlation").Range("F8").Value = x
Workbooks("Group 4 Correlation Solver").Sheets("Correlation").Range("C9").Value = x
Workbooks("Group 4 Correlation Solver").Sheets("Correlation").Range("D10").Value = x
Workbooks("Group 4 Correlation Solver").Sheets("STRUCTURETOOL").Calculate
x = x - 0.005
Workbooks("Weekly Option Update (Master).xlsm").Sheets("GDD Group").Cells(i, "H") = x + 0.005
Loop
I write this code in the module:
Public Function first()
If (x + 1 < 0) Or (1 - 2 * Sin(x) < 0) Or Sqr(1 - 2 * Sin(x)) = 0 Then
first = "error"
Else
first = Sqr(x + 1) / Sqr(1 - 2 * Sin(x))
End If
End Function
It gives an error with certain values:
Where is the problem?
I'm pretty sure that your intention is to evaluate Sin(x) where x is measured in degrees (if for no other reason than that evaluating at radians which are whole numbers other than 0 is quite rare), but the function Sin(x) works with radians. You can use the function Randians() to fix this:
Public Function first(ByVal x As Double) As Double
x = Application.Radians(x)
If (x + 1 < 0) Or (1 - 2 * Sin(x) < 0) Or Sqr(1 - 2 * Sin(x)) = 0 Then
first = "error"
Else
first = Sqr(x + 1) / Sqr(1 - 2 * Sin(x))
End If
End Function
Then, for example, first(7) evaluates to 1.218130941.
When x is 7, Sin(x) is equal to 0.656986598718789.
When you plug this into the formula 1 - 2 * Sin(x), you get -0.313973197437578.
You cannot take the square root (i.e. Sqr(...)) of a negative number. I would suggest adding Abs(...) as a wrapper to guarantee a positive number but I have no idea what you are ultimately trying to accomplish.
I need a pseudo random number generator for 2D Monte Carlo simulation that doesn't have the characteristic hyperplanes that you get with simple LCGs. I tested the random number generator Rnd() in Excel 2013 using the following code (takes about 5 secs to run):
Sub ZoomRNG()
Randomize
For i = 1 To 1000
Found = False
Do
x = Rnd() ' 2 random numbers between 0.0 and 1.0
y = Rnd()
If ((x > 0.5) And (x < 0.51)) Then
If ((y > 0.5) And (y < 0.51)) Then
' Write if both x & y in a narrow range
Cells(i, 1) = i
Cells(i, 2) = x
Cells(i, 3) = y
Found = True
End If
End If
Loop While (Not Found)
Next i
End Sub
Here is a simple plot of x vs y from running the above code
Not only is it not very random-looking, it has more obvious hyperplanes than the infamous RANDU algorithm does in 2D. Basically, am I using the function incorrectly or is the Rnd() function in VBA actually not the least bit usable?
For comparison, here's what I get for the Mersenne Twister MT19937 in C++.
To yield a better random generator and to make its performance faster, I modified your code like this:
Const N = 1000 'Put this on top of your code module
Sub ZoomRNG()
Dim RandXY(1 To N, 1 To 3) As Single, i As Single, x As Single, y As Single
For i = 1 To N
Randomize 'Put this in the loop to generate a better random numbers
Do
x = Rnd
y = Rnd
If x > 0.5 And x < 0.51 Then
If y > 0.5 And y < 0.51 Then
RandXY(i, 1) = i
RandXY(i, 2) = x
RandXY(i, 3) = y
Exit Do
End If
End If
Loop
Next
Cells(1, 9).Resize(N, 3) = RandXY
End Sub
I obtain this after plotting the result
The result looks better than your code's output. Modifying the above code a little bit to something like this
Const N = 1000
Sub ZoomRNG()
Dim RandXY(1 To N, 1 To 3) As Single, i As Single, x As Single, y As Single
For i = 1 To N
Randomize
Do
x = Rnd
If x > 0.5 And x < 0.51 Then
y = Rnd
If y > 0.5 And y < 0.51 Then
RandXY(i, 1) = i
RandXY(i, 2) = x
RandXY(i, 3) = y
Exit Do
End If
End If
Loop
Next
Cells(1, 9).Resize(N, 3) = RandXY
End Sub
yields a better result than the previous one
Sure the Mersenne Twister MT19937 in C++ is still better, but the last result is quite good for conducting Monte-Carlo simulations. FWIW, you might be interested in reading this paper: On the accuracy of statistical procedures in Microsoft Excel 2010.
That seems like it would take on average 1000 * 100 * 100 iterations to complete and VBA is usually a bit slower than native Excel formulas. Consider this example
Sub ZoomRNG()
t = Timer
[a1:a1000] = "=ROW()"
[b1:c1000] = "=RAND()/100+0.5"
[a1:c1000] = [A1:C1000].Value
Debug.Print CDbl(Timer - t) ' 0.0546875 seconds
End Sub
Update
It's not that bad at all! This will work too even without Randomize
Sub ZoomRNGs() ' VBA.Rnd returns Single
t = Timer
For i = 1 To 1000
Cells(i, 1) = i
Cells(i, 2) = Rnd / 100 + 0.5
Cells(i, 3) = Rnd / 100 + 0.5
Next i
Debug.Print Timer - t ' 0.25 seconds
End Sub
Sub ZoomRNGd() ' the Excel Function RAND() returns Double
t = Timer
For i = 1 To 1000
Cells(i, 1) = i
Cells(i, 2) = [RAND()] / 100 + 0.5
Cells(i, 3) = [RAND()] / 100 + 0.5
Next i
Debug.Print Timer - t ' 0.625 seconds
End Sub
and Single has about half of the precision of Double :
s = Rnd: d = [RAND()]
Debug.Print s; d; Len(Str(s)); Len(Str(d)) ' " 0.2895625 0.580839555868045 9 17 "
Update 2
I found C alternative that is as fast as VBA Rnd.
C:\Windows\System32\msvcrt.dll is the Microsoft C Runtime Library:
Declare Function rand Lib "msvcrt" () As Long ' this in a VBA module
and then you can use it like this x = rand / 32767 in your code:
Sub ZoomRNG()
t = Timer
Dim i%, x#, y#, Found As Boolean
For i = 1 To 1000
Found = False
Do
x = rand / 32767 ' RAND_MAX = 32,767
y = rand / 32767
If ((x > 0.5) And (x < 0.51)) Then
If ((y > 0.5) And (y < 0.51)) Then
' Write if both x & y in a narrow range
Cells(i, 1) = i
Cells(i, 2) = x
Cells(i, 3) = y
Found = True
End If
End If
Loop While (Not Found)
Next i
Debug.Print Timer - t ' 2.875 seconds
End Sub
After reading this question I got curious and found the paper
"Assessing Excel VBA Suitability for Monte Carlo Simulation" by Alexei Botchkarev that is available here. Both RAND and RND functions are not recommended, but as pointed out in the paper the Mersenne Twister has been implemented in VBA by Jerry Wang.
A quick search led me to this nicely commented Version that has been updated the last 2015/2/28: http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/VERSIONS/BASIC/MTwister.xlsb
Source: http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/VERSIONS/BASIC/basic.html
All LCGs will generate hyperplanes. The quality of the LCG increases with decreasing distance between these hyperplanes. So, having more hyperplanes than RANDU is a good thing.
The MT plot looks much better because it is NOT an LCG. Indeed, any non-LCG pRNG could have a random looking plot and still be a bad.
To avoid the problem of 2D correlations, you could use the same LCG for x and y but have different seeds for x and y. Of course, this will not work with RND because you cannot have two separate streams. You will need an LCG pRNG that takes the seed as an argument by reference.
As a balance between speed and goodness, I was thinking of combining them like
for...
z = [rand()] ' good but slow.
for .. ' just a few
t = z + rnd()
t = t - int(t)
...
Remember that good entropy + bad entropy = better entropy.
That said, only 0.05ms per [rand()].
I am making a loop that calculates the trajectory of a projectile and want the loop to stop when the projectile is at the same height as the target AND the projectile is on the decent. This is ensured by the Do Until... line. However, when the loop starts y(i-2) does not exist [y(-1)], resulting in a "runtime error '9' - subscript out of range". Using "On Error Resume Next" does allow the loop to continue but I often make mistakes and certainly will when adding more things to the loop (e.g. moving target, yaw, wind, etc.). For this reason I would like vba to ignore the runtime error only once and break on any following errors.
The relevant section of code is as follows:
vx(0) = V * Cos(Theta) 'set the initial conditions
vy(0) = V * Sin(Theta)
vz(0) = 0
x(0) = 0
y(0) = 0
z(0) = 0
i = 1
t = 0
On Error Resume Next
Do Until y(i - 1) < TargetAlt And y(i - 1) < y(i - 2) 'Stop when the projectile is at the same height
'as the target AND the projectile in on the
'decent of its trajectory
'If the projectile is moving up then drag and gravity are working together
'If not drag is working against gravity.
If vy(i - 1) > 0 Then
vy(i) = vy(i - 1) + h * (-g - (DragCof * (vy(i - 1) ^ 2)))
Else: vy(i) = vy(i - 1) + h * (-g + (DragCof * (vy(i - 1) ^ 2)))
End If
'The y position of the projectile
y(i) = y(i - 1) + h * (vy(i - 1))
'x direction velocity
vx(i) = vx(i - 1) + h * (-DragCof * (vx(i - 1) ^ 2))
'The x position of the projectile
x(i) = x(i - 1) + h * (vx(i - 1))
'z direction velocity
'The z position of the projectile
'parameters
t = t + h
i = i + 1
Loop
Starting the loop at i = 2 and adjusting the initial conditions accordingly would potentially work however I would like to avoid this if possible.
There are certain exceptional circumstances in which there is no choice but to use On Error Resume Next for flow control — but this isn't one of them. In this case it will just cause you pain.
By moving your logic around a little bit, you can deal with the first iteration edge case much more simply. For example, the stopping criterion check can be moved to the bottom of your loop like this:
Do
'... code to calculate projectile position at this time step...
'Advance to next time step
t = t + h
i = i + 1
'Get out when projectile falls below target height AND is on descent
Loop Until y(i - 1) < TargetAlt And y(i - 1) < y(i - 2)