I am attempting to set up a list from double type x to double type y, incremented by .001.
dblx = .093
dbly = .103
do while dblx <= dbly
"INSERT STATEMENT for dblx"
dblx = dblx + .001
loop
Now this works until I get to .102.
If dbly < .102 I have no issues but >= .102 the last iteration never occurs.
Am I going crazy?? I know .103 <= .103! But for some reason Access doesn't?
At first I thought it may have been the variable type, they are both doubles. I've stepped through, changed the read in values to hard set values, attempted different ranges of values... Again anything less than .102 doesn't give issues, but as soon as my "anchor value" (Max threshold) is greater than or equal to .102 then the last iteration of the do loop never works
The answer is to use the Decimal Type, which is a bit awkward as the have to be declared as variant and then assigned using cdec.
Sub TestDecimal()
Dim dblx As Variant
Dim dbly As Variant
dblx = CDec(0.093)
dbly = CDec(0.103)
Do While dblx <= dbly
Debug.Print dblx
dblx = dblx + cdec(0.001)
Loop
End Sub
Output
0.093
0.094
0.095
0.096
0.097
0.098
0.099
0.1
0.101
0.102
0.103
Floating point arithmetic is not precise. E.g. you might get 0.103000000001213 instead of 0.103. Therefore add a little value (epsilon) to the tested end value
Sub Test()
Const Eps = 0.00000001
Dim dblx As Double, dbly As Double
dblx = 0.093
dbly = 0.103
Do While dblx <= dbly + Eps
Debug.Print dblx, dbly
dblx = dblx + 0.001
Loop
End Sub
I would trust your gut on this one, and still remember that the computer is only doing what you told it to do.
If I were to bet on the problem, whatever code that happens inside "INSERT STATEMENT for dblx" is causing you to miss the final increment.
For a sanity check, I went ahead and tested the code:
Sub check_double()
Dim dblx As Double
Dim dbly As Double
dblx = 0.093
dbly = 0.103
Do While dblx <= dbly
dblx = dblx + 0.001
Debug.Print dblx
Loop
End Sub
This yeilded an output of:
0.094
0.095
0.096
0.097
0.098
0.099
0.1
0.101
0.102
0.103
If you have four decimals or less, use Currency for such tasks to avoid the floating point errors:
Public Function LoopTest()
Dim dblx As Currency
Dim dbly As Currency
dblx = 0.093
dbly = 0.103
Do While dblx <= dbly
' "INSERT STATEMENT for dblx"
dblx = dblx + 0.001
Debug.Print dblx
Loop
End Function
Output:
0.094
0.095
0.096
0.097
0.098
0.099
0.1
0.101
0.102
0.103
0.104
Related
EDIT: People pointed out that I was using Integer instead of Long...when I changed it, the formula returned 0...so it is still failing.
I have the following code
Public Function BreakEven(currenttier As Double, currentrate As Double, nexttier As Double, nextrate As Double) As Double
Dim x As Long
Dim y As Long
x = currentrate * currenttier
y = nexttier * nextrate
If currenttier >= nexttier Then
MsgBox "currenttier must be less than nexttier"
Else
Do Until (x = y)
currenttier = currenttier + 1
x = currentrate * currenttier
Loop
End If
BreakEven = currenttier
End Function
The purpose is to find the breakeven point in a cost structure, where a certain value (currenttier and nexttier) gives a corresponding interest rate. The interest rate changes when you reach the next tier...this calculates at what point in the lower tier, are you better off paying for the next tier (to reap the benefit of the 2nd tiers interest rate)
This code works fine when I use the numbers 100,000 and 200,000 (rates, but fails when it is upgraded to 1.5 mil to 2 mil (returns #VALUE)....I've tried changing the Do Until from X=y to include a wider margin for error (+-100)...yet it still seems to fail. Any ideas as to why.
The If statement is so that the loop doesn't enter an infinite loop and break excel.
VBA integers are 16 bit with a maximum value of 32767. I kid you not!
Use a Long instead. This will be good for just over 2 billion.
Integer max value is 2,147,483,647
so when you multiply 2 million by 1.5 mil for example the number goes beyond that.
Try using Big INt or Long
Try this code
Public Function BreakEven(currenttier As Double, currentrate As Double, nexttier As Double, nextrate As Double) As Double
Dim x As Double
Dim y As Double
x = currentrate * currenttier
y = nexttier * nextrate
If currenttier >= nexttier Then
MsgBox "currenttier must be less than nexttier"
Exit Function
---- or any other action----
Else
Do while x < y
currenttier = currenttier + 1
x = currentrate * currenttier
Loop
End If
BreakEven = currenttier
End Function
I don't understand why I have this row Application.Wait in error (highlighted in yellow) ?
Sub Wait_Random()
Dim Low As Double
Dim High As Double
Low = 90 '<<< CHANGE AS DESIRED
High = 126 '<<< CHANGE AS DESIRED
r = Int((High - Low + 1) * Rnd() + Low)
Application.Wait Now + TimeValue("00:00:" & CStr(r))
End Sub
I have found that the problem is that this code is trying "to add a number to a string of characters". But I am lost ! Thanks in advance ;)
It's because your r variable always greater than 59 sec. (actually it's alwasys greater 90). You should change Low and High so that r would never be greater 59:
Sub Wait_Random()
Dim Low As Double
Dim High As Double
Dim r as Integer
Low = 1 '<<< CHANGE AS DESIRED
High = 59 '<<< CHANGE AS DESIRED
r = Int((High - Low) * Rnd() + Low)
Application.Wait Now + TimeValue("00:00:" & CStr(r))
End Sub
Or another way you could use
Application.Wait DateAdd("s", r, Now)
to add r seconds. In that case r could be greater 59.
I'm trying to minimize the value of the sum of the residuals squared by varying the value of De, which is found in F1. I want the values of CFL Calculated to be as close as possible to the values of CFL Measured. The smaller the sum of those residuals squared, the better the fit! After asking stackoverflow for some advice, I decided to use Goal Seek to minimize the sum of the residuals squared to get as close to zero as possible by varying the value of De, which I want to find the most ideal value of.
I got this program to run perfectly, or so I thought... I found out that instead of summing every single residuals using =SUM(D2:D14), I accidentally used =SUM(D2,D14). So I was only summing up the first and last numbers.
Now that I'm trying to sum every residual squared up, I'm getting these crazy errors, and an insane value for De.
I know that the value of De has to be greater than zero, and less than one. how can I use these bounds to keep this goal seek focused within a certain range? The answer for De in this case is about .012, if that helps. I keep getting the error #NUM! in all of the residual cells. Is this because of overflow issues?
If you've concluded that using Goal Seek to minimize these sums by finding the most ideal value of De will not work, how would you go about it? Are there any other solvers I could use?
Here is the code:
Option Explicit
Dim Counter As Long
Dim DeSimpleFinal As Double
Dim simpletime As Variant
Dim Tracker As Double
Dim StepAmount As Double
Dim Volume As Double
Dim SurfArea As Double
Dim pi As Double
Dim FinalTime As Variant
Dim i As Variant
Sub SimpleDeCalculationNEW()
'This is so you can have the data and the table I'm working with!
Counter = 13
Volume = 12.271846
SurfArea = 19.634954
pi = 4 * Atn(1)
Range("A1") = "Time(days)"
Range("B1") = "CFL(measured)"
Range("A2").Value = 0.083
Range("A3").Value = 0.292
Range("A4").Value = 1
Range("A5").Value = 2
Range("A6").Value = 3
Range("A7").Value = 4
Range("A8").Value = 5
Range("A9").Value = 6
Range("A10").Value = 7
Range("A11").Value = 8
Range("A12").Value = 9
Range("A13").Value = 10
Range("A14").Value = 11
Range("B2").Value = 0.0612
Range("B3").Value = 0.119
Range("B4").Value = 0.223
Range("B5").Value = 0.306
Range("B6").Value = 0.361
Range("B7").Value = 0.401
Range("B8").Value = 0.435
Range("B9").Value = 0.459
Range("B10").Value = 0.484
Range("B11").Value = 0.505
Range("B12").Value = 0.523
Range("B13").Value = 0.539
Range("B14").Value = 0.554
Range("H2").Value = Volume
Range("H1").Value = SurfArea
Range("C1") = "CFL Calculated"
Range("D1") = "Residual Squared"
Range("E1") = "De value"
Range("F1").Value = 0.1
'Inserting Equations
Range("C2") = "=((2 * $H$1) / $H$2) * SQRT(($F$1 * A2) / PI())"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C" & Counter + 1), Type:=xlFillDefault
Range("D2") = "=((ABS(B2-C2))^2)"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & Counter + 1), Type:=xlFillDefault
'Summing up the residuals squared
Range("D" & Counter + 2) = "=Sum(D2: D" & Counter + 1 & ")"
'Goal Seek
Range("D" & Counter + 2).GoalSeek Goal:=0, ChangingCell:=Range("F1")
Columns("A:Z").EntireColumn.EntireColumn.AutoFit
DeSimpleFinal = Range("F1")
MsgBox ("The Final Value for DeSimple is: " & DeSimpleFinal)
End Sub
You're getting NUM errors because the value of F1 is going negative in your current solution -- and you are trying to take the square root of F1 in one of your expressions.
Also, goal seek is, in this instance, incredibly sensitive to the particular initial starting "guess" for F1 that you are using. This will be evident if you vary the F1 initial value by a little bit on either side of the 0.1 you are using now. There are, in fact, large regions of instability in the goal seek solution, depending on the F1 value:
As you brought up in your question, you are more likely to get a useable result if you can set constraints on the possible inputs to your solution search. Excel comes with an add-in called Solver that allows that, as well as offers several different search methods. Solver is not loaded automatically when you first start Excel, but loading it is easy, as explained here.
You ask for other solvers. For alternatives and a bit of theory to help understand what's going on, have a look at Numerical Recipes (online books here). Chapter 10 deals with this. It includes ready-made code samples if you want to try something different than GoalSeek or the Solver add-in. Of course the code is in Fortran/C/C++ but these are readily translated into VBA (I've done this many times).
The goalseek function uses a dichotomy algorithm which can be coded like this:
Sub dicho(ByRef target As Range, ByRef modif As Range, ByVal targetvalue As Double, ByVal a As Double, ByVal b As Double)
Dim i As Integer
Dim imax As Integer
Dim eps As Double
eps = 0.01
imax = 10
i = 0
While Abs(target.Value - targetvalue) / Abs(targetvalue) > eps And i < imax
modif.Value = (a + b) / 2
If target.Value - targetvalue > 0 Then
a = (a + b) / 2
Else
b = (a + b) / 2
End If
i = i + 1
Wend
End Sub
Where a and b are you bounds.
I'm trying to use "And" & "Or" within an If statement. I probably have my syntax wrong.
the result comes back false when the data should make it true. Here is the code:
ElseIf (origNum = "006260006" Or origNum = "30062600006") And creditOrDebit = "D" Then
'do things here
End If
-When I debug and come to this line it hops over it and doesn't enter in.
-origNum actually equals "006260006" and creditOrDebit = "D".
-so I'm assuming my "Or" statement isn't working.
-Hopefully this is a quick easy question. Thanks!
The problem is probably somewhere else. Try this code for example:
Sub test()
origNum = "006260006"
creditOrDebit = "D"
If (origNum = "006260006" Or origNum = "30062600006") And creditOrDebit = "D" Then
MsgBox "OK"
End If
End Sub
And you will see that your Or works as expected. Are you sure that your ElseIf statement is executed (it will not be executed if any of the if/elseif before is true)?
This is not an answer, but too long for a comment.
In reply to JP's answers / comments, I have run the following test to compare the performance of the 2 methods. The Profiler object is a custom class - but in summary, it uses a kernel32 function which is fairly accurate (Private Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)).
Sub test()
Dim origNum As String
Dim creditOrDebit As String
Dim b As Boolean
Dim p As Profiler
Dim i As Long
Set p = New_Profiler
origNum = "30062600006"
creditOrDebit = "D"
p.startTimer ("nested_ifs")
For i = 1 To 1000000
If creditOrDebit = "D" Then
If origNum = "006260006" Then
b = True
ElseIf origNum = "30062600006" Then
b = True
End If
End If
Next i
p.stopTimer ("nested_ifs")
p.startTimer ("or_and")
For i = 1 To 1000000
If (origNum = "006260006" Or origNum = "30062600006") And creditOrDebit = "D" Then
b = True
End If
Next i
p.stopTimer ("or_and")
p.printReport
End Sub
The results of 5 runs (in ms for 1m loops):
20-Jun-2012 19:28:25
nested_ifs (x1): 156 - Last Run: 156 - Average Run: 156
or_and (x1): 125 - Last Run: 125 - Average Run: 125
20-Jun-2012 19:28:26
nested_ifs (x1): 156 - Last Run: 156 - Average Run: 156
or_and (x1): 125 - Last Run: 125 - Average Run: 125
20-Jun-2012 19:28:27
nested_ifs (x1): 140 - Last Run: 140 - Average Run: 140
or_and (x1): 125 - Last Run: 125 - Average Run: 125
20-Jun-2012 19:28:28
nested_ifs (x1): 140 - Last Run: 140 - Average Run: 140
or_and (x1): 141 - Last Run: 141 - Average Run: 141
20-Jun-2012 19:28:29
nested_ifs (x1): 156 - Last Run: 156 - Average Run: 156
or_and (x1): 125 - Last Run: 125 - Average Run: 125
Note
If creditOrDebit is not "D", JP's code runs faster (around 60ms vs. 125ms for the or/and code).
I like assylias' answer, however I would refactor it as follows:
Sub test()
Dim origNum As String
Dim creditOrDebit As String
origNum = "30062600006"
creditOrDebit = "D"
If creditOrDebit = "D" Then
If origNum = "006260006" Then
MsgBox "OK"
ElseIf origNum = "30062600006" Then
MsgBox "OK"
End If
End If
End Sub
This might save you some CPU cycles since if creditOrDebit is <> "D" there is no point in checking the value of origNum.
Update:
I used the following procedure to test my theory that my procedure is faster:
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Sub DoTests2()
Dim startTime1 As Long
Dim endTime1 As Long
Dim startTime2 As Long
Dim endTime2 As Long
Dim i As Long
Dim msg As String
Const numberOfLoops As Long = 10000
Const origNum As String = "006260006"
Const creditOrDebit As String = "D"
startTime1 = timeGetTime
For i = 1 To numberOfLoops
If creditOrDebit = "D" Then
If origNum = "006260006" Then
' do something here
Debug.Print "OK"
ElseIf origNum = "30062600006" Then
' do something here
Debug.Print "OK"
End If
End If
Next i
endTime1 = timeGetTime
startTime2 = timeGetTime
For i = 1 To numberOfLoops
If (origNum = "006260006" Or origNum = "30062600006") And _
creditOrDebit = "D" Then
' do something here
Debug.Print "OK"
End If
Next i
endTime2 = timeGetTime
msg = "number of iterations: " & numberOfLoops & vbNewLine
msg = msg & "JP proc: " & Format$((endTime1 - startTime1), "#,###") & _
" ms" & vbNewLine
msg = msg & "assylias proc: " & Format$((endTime2 - startTime2), "#,###") & _
" ms"
MsgBox msg
End Sub
I must have a slow computer because 1,000,000 iterations took nowhere near ~200 ms as with assylias' test. I had to limit the iterations to 10,000 -- hey, I have other things to do :)
After running the above procedure 10 times, my procedure is faster only 20% of the time. However, when it is slower it is only superficially slower. As assylias pointed out, however, when creditOrDebit is <>"D", my procedure is at least twice as fast. I was able to reasonably test it at 100 million iterations.
And that is why I refactored it - to short-circuit the logic so that origNum doesn't need to be evaluated when creditOrDebit <> "D".
At this point, the rest depends on the OP's spreadsheet. If creditOrDebit is likely to equal D, then use assylias' procedure, because it will usually run faster. But if creditOrDebit has a wide range of possible values, and D is not any more likely to be the target value, my procedure will leverage that to prevent needlessly evaluating the other variable.
Could there be any specific reason why one can choose UBound over Length?
Here is the code and 1-dimension is passed as second parameter.
For iIndex = 0 To UBound(myList)
If Left(Request.ServerVariables("REMOTE_ADDR"), Len(myList(iIndex))) = saIPList(iIndex) Then
bAuth = True
Exit For
End If
Next
Any performance gain against Length
They do different things! UBound gives you the last index in the array, while Length gives you the length. Those are not the same, because usually UBound will be Length - 1.
Ubound exists mainly for backwards compatibility to old code. I haven't seen anything saying it's deprecated just yet, but at the same time I recognize it's not really aligned with the way they have been taking the language in recent years. The same is true for the Len() and Left() functions in that code; they are the way of the past, not the future. The sooner you adapt, the happier you will be.
For what it's worth, the argument is largely moot. More "modern" ways to write that code look entirely different. Here's one example:
bAuth = myList.Zip(saIPList, Function(a,b) New With {.Length = a.Length, .saIP = b} ) _
.Any(Function(i) Request.ServerVariables("REMOTE_ADDR").ToString().SubString(0,i.Length) = i.saIP)
For performance gain I was also interested in what function has the best performance.
It seems that the length -1 is much faster than the UBound. I expected UBound to be faster somehow.
After 100.000.000 times it seems the time for length -1 is 952ms and for UBound: 5844ms.
(length -1) is ~6 times faster than UBound
Code used for testing
Private Sub UboundlengthToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles UboundlengthToolStripMenuItem.Click
ListBox1.Items.Clear()
ListBox1.Items.Add("BEGIN")
'set required vars
Dim ints() As Integer = {1, 2, 3, 4, 5}
'end vars setting
Dim t As New Stopwatch
Dim gt As New Stopwatch
Dim time1 As Integer
Dim temp As Integer
Dim d As Double = GC.GetTotalMemory(False)
GC.Collect()
GC.WaitForPendingFinalizers()
GC.Collect()
GC.GetTotalMemory(False)
ListBox1.Items.Add("Free Memory: " & d)
gt.Start()
t.Reset()
'starting test---------------------------------------
'single test---------------------------------------
t.Start()
For i As Integer = 0 To TextBox1.Text
temp = ints(ints.Length - 1)
Next
t.Stop()
time1 = t.ElapsedMilliseconds
ListBox1.Items.Add("arr.length - 1")
ListBox1.Items.Add("Func1 total time: " & time1)
ListBox1.Items.Add("Func1 single time: " & time1 / TextBox1.Text)
t.Reset()
'single test---------------------------------------
'single test---------------------------------------
t.Start()
For i As Integer = 0 To TextBox1.Text
temp = ints(UBound(ints))
Next
t.Stop()
time1 = t.ElapsedMilliseconds
ListBox1.Items.Add("UBound:")
ListBox1.Items.Add("Func1 total time: " & time1)
ListBox1.Items.Add("Func1 single time: " & time1 / TextBox1.Text)
t.Reset()
'single test---------------------------------------
'Finishing test--------------------------------------
gt.Stop()
ListBox1.Items.Add("Total time " & gt.ElapsedMilliseconds)
d = GC.GetTotalMemory(True) - d
ListBox1.Items.Add("Total Memory Heap consuming (bytes)" & d)
ListBox1.Items.Add("END")
End Sub
Tried different things to eliminate possible optimalisations of the compiler, all with the same result as stated above.
It's carried over from earlier VB days. UBound can give you the highest index of any single dimension in a multi-dimensional array. Length only gives you the total number of elements.
If you declare:
' A 5x10 array:
Dim array(4, 9) As Integer
The values are:
array.Length = 50 ' Total number of elements.
array.Rank = 2 ' Total number of dimensions.
array.LBound(0) = 0 ' Minimum index of first dimension.
array.LBound(1) = 0 ' Minimum index of second dimension.
array.UBound(0) = 4 ' Maximum index of first dimension.
array.UBound(1) = 9 ' Maximum index of second dimension.
Interesting UBounds is quite a bit faster in this example
Dim startTick As Long
For j As Integer = 1 To 5
Dim rnd As New Random(Now.Subtract(Now.Date).TotalSeconds)
Dim RandomMax As Integer = rnd.Next(10000, 100000)
Dim cumbersome() As Integer = New Integer() {rnd.Next}
'Ubound is better than Length. Using Length takes as much time as redimensioning the entire array.
startTick = Environment.TickCount
For i As Integer = 1 To RandomMax - 1
ReDim Preserve cumbersome(UBound(cumbersome) + 1)
cumbersome(UBound(cumbersome)) = Rnd.Next
Next
Debug.Print("{0}) Array Method UBound: {1} Ticks to construct {2} integers", j, Environment.TickCount - startTick, RandomMax)
'Length is slow don't use it
startTick = Environment.TickCount
For i As Integer = 1 To RandomMax - 1
ReDim Preserve cumbersome(cumbersome.Length)
cumbersome(cumbersome.Length - 1) = Rnd.Next
Next
Debug.Print("{0}) Array Method Length: {1} Ticks to construct {2} integers", j, Environment.TickCount - startTick, RandomMax)
Next