The following code is easy and outputs as expected
CODE:
Option Explicit
Sub Test_loop2()
Dim i As Long
For i = -3 To 3 Step 1
Debug.Print i
Next i
End Sub
OUTPUT:
The following code is exiting early due to rounding
Option Explicit
Sub Test_loop2()
Dim i As Double
For i = -0.3 To 0.3 Step 0.1
Debug.Print i
Next i
End Sub
OUTPUT:
What is the most reliable method I can use whilst retaining a For Loop to ensure the last value is run in the loop for non integers?
Eg For i = X to Y step Z - Y must always be reached if it's multiple of Z
For i = 0 to 0.3 step 0.1 then 0.3 will be in loop
For i = 0 to 0.3 step 0.2 then 0.3 will NOT be in the loop
Floating point arithmetic will eventually screw you if you use a Double (or Single) as counter.
For counters, stick to whole numbers. Then derive your floating point value from that counter. Example:
Dim i As Long
Dim d As Double
For i = 0 To 6
d = (i - 3) * 0.1 ' or whatever formula needed
Debug.Print d
Next i
Another option for Double as loop limits and counter
Sub dTest()
Dim i As Double
For i = -0.31 To 0.31 Step 0.1
Debug.Print Round(i, 1)
Next
End Sub
Result:
-0.3
-0.2
-0.1
0
0.1
0.2
0.3
Looks like using decimal instead of double works here
Sub Test_loop2()
Dim i As Variant
Dim ffrom As Variant
Dim fto As Variant
Dim fInc As Variant
ffrom = CDec(-0.3)
fto = CDec(0.3)
fInc = CDec(0.1)
For i = ffrom To fto Step fInc
Debug.Print i
Next i
End Sub
GD,
The problem with using Double (or Float) values in a loop is that both of them are an approximation of a value.
To have a loop end on encountering an absolute, such as:
For i=1 to 5
Would require i to be exactly 5 in order for the loop to work properly, yet the double datatype could be anything from 4.999999999 to 5.000000001 (as example) which would subsequently not satisfy the =5 requirement of the For To loop. You could potentially opt for choosing a
Do
'do some code here
Loop Until i>5
where the threshold becomes a bit more vague, which is ideal for float or double datatypes.
Normally it's best practice as per #Jean-François Corbett 's answer to use only 'Integer' or 'Long' datatypes in the counter and step values and use a formula to adjust whatever counting/calculation method you require for your code variable.
I simply added a constant of 0.00001 to the upper limit to avoid the issue of floating point inaccuracy mentioned above, e.g.:
For s = 12 To 19.5 + 0.00001 Step 0.1
The code shows sample values that originally highlighted the problem to me, but apart from the constant 0.00001 these could be variables. If your increment could be less than 0.00001 you might need to fine tune this.
Probably the quickest solution I found was to use the Round operand.
Sub Test_loop2()
Dim i As Double
For i = -0.3 To 0.3 Step 0.1
Debug.Print Round(i, 1)
Next i
End Sub
Related
I have trouble comparing 2 double in Excel VBA
suppose that I have the following code
Dim a as double
Dim b as double
a = 0.15
b = 0.01
After a few manipulations on b, b is now equal to 0.6
however the imprecision related to the double data type gives me headache because
if a = b then
//this will never trigger
end if
Do you know how I can remove the trailing imprecision on the double type?
You can't compare floating point values for equality. See this article on "Comparing floating point numbers" for a discussion of how to handle the intrinsic error.
It isn't as simple as comparing to a constant error margin unless you know for sure what the absolute range of the floats is beforehand.
if you are going to do this....
Dim a as double
Dim b as double
a = 0.15
b = 0.01
you need to add the round function in your IF statement like this...
If Round(a,2) = Round(b,2) Then
//code inside block will now trigger.
End If
See also here for additional Microsoft reference.
It is never wise to compare doubles on equality.
Some decimal values map to several floating point representations. So one 0.6 is not always equal to the other 0.6.
If we subtract one from the other, we probably get something like 0.00000000051.
We can now define equality as having a difference smaller that a certain error margin.
Here is a simple function I wrote:
Function dblCheckTheSame(number1 As Double, number2 As Double, Optional Digits As Integer = 12) As Boolean
If (number1 - number2) ^ 2 < (10 ^ -Digits) ^ 2 Then
dblCheckTheSame = True
Else
dblCheckTheSame = False
End If
End Function
Call it with:
MsgBox dblCheckTheSame(1.2345, 1.23456789)
MsgBox dblCheckTheSame(1.2345, 1.23456789, 4)
MsgBox dblCheckTheSame(1.2345678900001, 1.2345678900002)
MsgBox dblCheckTheSame(1.2345678900001, 1.2345678900002, 14)
As has been pointed out, many decimal numbers cannot be represented precisely as traditional floating-point types. Depending on the nature of your problem space, you may be better off using the Decimal VBA type which can represent decimal numbers (base 10) with perfect precision up to a certain decimal point. This is often done for representing money for example where 2-digit decimal precision is often desired.
Dim a as Decimal
Dim b as Decimal
a = 0.15
b = 0.01
Late answer but I'm surprised a solution hasn't been posted that addresses the concerns outlined in the article linked in the (currently) accepted answer, namely that:
Rounding checks equality with absolute tolerance (e.g. 0.0001 units if rounded to 4d.p.) which is rubbish when comparing different values on multiple orders of magnitude (so not just comparing to 0)
Relative tolerance that scales with one of the numbers being compared meanwhile is not mentioned in the current answers, but performs well on non-zero comparisons (however will be bad at comparing to zero as the scaling blows up around then).
To solve this, I've taken inspiration from Python: PEP 485 -- A Function for testing approximate equality to implement the following (in a standard module):
Code
'#NoIndent: Don't want to lose our description annotations
'#Folder("Tests.Utils")
Option Explicit
Option Private Module
'Based on Python's math.isclose https://github.com/python/cpython/blob/17f94e28882e1e2b331ace93f42e8615383dee59/Modules/mathmodule.c#L2962-L3003
'math.isclose -> boolean
' a: double
' b: double
' relTol: double = 1e-09
' maximum difference for being considered "close", relative to the
' magnitude of the input values
' absTol: double = 0.0
' maximum difference for being considered "close", regardless of the
' magnitude of the input values
'Determine whether two floating point numbers are close in value.
'Return True if a is close in value to b, and False otherwise.
'For the values to be considered close, the difference between them
'must be smaller than at least one of the tolerances.
'-inf, inf and NaN behave similarly to the IEEE 754 Standard. That
'is, NaN is not close to anything, even itself. inf and -inf are
'only close to themselves.
'#Description("Determine whether two floating point numbers are close in value, accounting for special values in IEEE 754")
Public Function IsClose(ByVal a As Double, ByVal b As Double, _
Optional ByVal relTol As Double = 0.000000001, _
Optional ByVal absTol As Double = 0 _
) As Boolean
If relTol < 0# Or absTol < 0# Then
Err.Raise 5, Description:="tolerances must be non-negative"
ElseIf a = b Then
'Short circuit exact equality -- needed to catch two infinities of
' the same sign. And perhaps speeds things up a bit sometimes.
IsClose = True
ElseIf IsInfinity(a) Or IsInfinity(b) Then
'This catches the case of two infinities of opposite sign, or
' one infinity and one finite number. Two infinities of opposite
' sign would otherwise have an infinite relative tolerance.
'Two infinities of the same sign are caught by the equality check
' above.
IsClose = False
Else
'Now do the regular computation on finite arguments. Here an
' infinite tolerance will always result in the function returning True,
' since an infinite difference will be <= to the infinite tolerance.
'This is to supress overflow errors as we deal with infinity.
'NaN has already been filtered out in the equality checks earlier.
On Error Resume Next
Dim diff As Double: diff = Abs(b - a)
If diff <= absTol Then
IsClose = True
ElseIf diff <= CDbl(Abs(relTol * b)) Then
IsClose = True
ElseIf diff <= CDbl(Abs(relTol * a)) Then
IsClose = True
End If
On Error GoTo 0
End If
End Function
'#Description "Checks if Number is IEEE754 +/- inf, won't raise an error"
Public IsInfinity(ByVal Number As Double) As Boolean
On Error Resume Next 'in case of NaN
IsInfinity = Abs(Number) = PosInf
On Error GoTo 0
End Function
'#Description "IEEE754 -inf"
Public Property Get NegInf() As Double
On Error Resume Next
NegInf = -1 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 +inf"
Public Property Get PosInf() As Double
On Error Resume Next
PosInf = 1 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 signaling NaN (sNaN)"
Public Property Get NaN() As Double
On Error Resume Next
NaN = 0 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 quiet NaN (qNaN)"
Public Property Get QNaN() As Double
QNaN = -NaN
End Property
Updated to incorporate great feedback from Cristian Buse
Examples
The IsClose function can be used to check for absolute difference:
assert(IsClose(0, 0.0001233, absTol:= 0.001)) 'same to 3 d.p.?
... or relative difference:
assert(IsClose(1234.5, 1234.6, relTol:= 0.0001)) '0.01% relative difference?
... but generally you specify both and if either tolerance is met then the numbers are considered close. It has special handling of +-infinity which are only close to themselves, and NaN which is close to nothing (see the PEP for full justification, or my Code Review post where I'd love feedback on this code :)
The Currency data type may be a good alternative. It handles relatively large numbers with fixed four digit precision.
Work-a-round??
Not sure if this will answer all scenarios, but I ran into a problem comparing rounded double values in VBA. When I compared to numbers that appeared to be identical after rounding, VBA would trigger false in an if-then compare statement.
My fix was to run two conversions, first double to string, then string to double, and then do the compare.
Simulated Example
I did not record the exact numbers that caused the error mentioned in this post, and the amounts in my example do not trigger the problem currently and are intended to represent the type of issue.
Sub Test_Rounded_Numbers()
Dim Num1 As Double
Dim Num2 As Double
Let Num1 = 123.123456789
Let Num2 = 123.123467891
Let Num1 = Round(Num1, 4) '123.1235
Let Num2 = Round(Num2, 4) '123.1235
If Num1 = Num2 Then
MsgBox "Correct Match, " & Num1 & " does equal " & Num2
Else
MsgBox "Inccorrect Match, " & Num1 & " does not equal " & Num2
End If
'Here it would say that "Inccorrect Match, 123.1235 does not equal 123.1235."
End Sub
Sub Fixed_Double_Value_Type_Compare_Issue()
Dim Num1 As Double
Dim Num2 As Double
Let Num1 = 123.123456789
Let Num2 = 123.123467891
Let Num1 = Round(Num1, 4) '123.1235
Let Num2 = Round(Num2, 4) '123.1235
'Add CDbl(CStr(Double_Value))
'By doing this step the numbers
'would trigger if they matched
'100% of the time
If CDbl(CStr(Num1)) = CDbl(CStr(Num2)) Then
MsgBox "Correct Match"
Else
MsgBox "Inccorrect Match"
End If
'Now it says Here it would say that "Correct Match, 123.1235 does equal 123.1235."
End Sub
Depending on your situation and your data, and if you're happy with the level of precision shown by default, you can try comparing the string conversions of the numbers as a very simple coding solution:
if cstr(a) = cstr(b)
This will include as much precision as would be displayed by default, which is generally sufficient to consider the numbers equal.
This would be inefficient for very large data sets, but for me was useful when reconciling imported data which was identical but was not matching after storing the data in VBA Arrays.
Try to use Single values if possible.
Conversion to Double values generates random errors.
Public Sub Test()
Dim D01 As Double
Dim D02 As Double
Dim S01 As Single
Dim S02 As Single
S01 = 45.678 / 12
S02 = 45.678
D01 = S01
D02 = S02
Debug.Print S01 * 12
Debug.Print S02
Debug.Print D01 * 12
Debug.Print D02
End Sub
45,678
45,678
45,67799949646
45,6780014038086
In trying to solve this question, I wrote the following in an attempt to implement the Box-Muller transform to generate random normal variables in pure VBA:
Function RandNorm(Optional mean As Double = 0, Optional sd As Double = 1) As Double
Dim s As Double
s = Sqr(-2 * Log(Rnd())) * Cos(6.283185307 * Rnd()) '6.28 etc. is 2*pi
RandNorm = mean + sd * s
End Function
The following somewhat weak test always works, returning a number close to 0:
Sub test1()
Randomize
Dim s As Double
Dim i As Long
For i = 1 To 17000000
s = s + RandNorm()
Next i
Debug.Print s / 17000000
End Sub
On the other hand, the following test never works (because it tries to take the log of 0, which is undefined):
Sub test2()
Randomize
Dim s As Double
Dim i As Long
Debug.Print Rnd() 'just to clock it
For i = 1 To 17000000
s = s + RandNorm()
Next i
Debug.Print s / 17000000
End Sub
The problem is that rnd() returns 0 on average once out of every 2^24 (a bit less than 17,000,000) calls. It is of course easy enough to tweak the definition of RandNorm to avoid the zero (see the linked-to question), but I am still puzzled by the above code. It would make perfect sense to me if each test failed half the time (when the zero is fed into Log()) and worked half the time (when the zero is fed into Cos()). It seems that Randomize avoids at least half of the possible seeds.
Why does Randomize behave this way? Is there a way to seed the random number generator so that all possible states of the random number generator can occur?
On Edit
If I define the following sub:
Sub ReRandomize()
Dim r As Double
Randomize
If Rnd() > 0.5 Then r = Rnd()
End Sub
And modify test1 and test2 above to use ReRandomize instead of Randomize, both of the test subs will fail 50% of the time, so that might answer the part of the question about if there is "a way to seed the random number generator so that all possible states of the random number generator can occur?" It is still mysterious as to why Randomize behaves the way that it does. This is the second time that an Excel VBA question made me realize that Randomize is a weird sub. None of this matters very much for typical use of rnd(), but it does underscore that it is a somewhat low quality random number generator which shouldn't be used for serious statistical work.
I simply modified the Rnd calc to not include 0 or 1. You have to remember that the Rnd Function can produce a number (of type double) in the range of 0 or 1. Therefore, it's chances of having a duplicate number are pretty low.
dbl1stRnd = Rnd()
dblRnd = (0.9999 - 0.0001) * dbl1stRnd + 0.0001
s = Sqr(-2 * Log(dblRnd)) * Cos(6.283185307 * dblRnd) '6.28 etc. is 2*pi
Some example outputs of the regular Rnd() function with Randomize:
3.633606E-02
0.2324036
0.3460443
0.5870923
5.553758E-02
0.2629338
0.2400494
0.1982901
0.5923058
0.7915452
0.4874671
0.2062811
0.5676001
0.1178594
1.932621E-03
0.4326598
0.8291379
I hope this explains some and is what you are looking for.
I have a variable in VBA that I need to truncate to 4 significant figures. I can't seem to find anything that won't round the number up or down. But I just want to remove the numbers after the 4th significant figure. I've tried,
compressibility = round(compress, -3 - (Int(Log(Abs(compress)))))
It removes the numbers after the 4th digit but it still rounds the number up.
Compress is a number around 0.000245848385 as an example, and I need the compressibility number to be 0.0002458.
Any suggestions would be great! Thanks.
Try this function:
Function RoundSignificant(ByVal dValue As Double, iFigures As Integer)
Dim dSig As Double
dSig = Abs(dValue)
dSig = Application.Log10(dSig)
dSig = 1 + Int(dSig)
dSig = iFigures - dSig
RoundSignificant = Round(dValue, dSig)
End Function
Sub test()
Debug.Print RoundSignificant(0.000245848385, 4)
End Sub
Using worksheet functions:
=VALUE(TEXT(compress,"0.000E+00"))
For VBA
CDbl(Format(compress,"0.000E+00"))
Hope that helps.
It seems to me that you want to avoid rounding UP, but not rounding down, since rounding down should produce the exact result you want. So, instead of using VBA Round function, you could use Excel WorksheetFunction.RoundDown method to achieve the result you need.
ROUNDDOWN(0.00024586548385;7)=0.000245800000
ROUNDDOWN(0.00024583548385;7)=0.000245800000
Sub test()
Dim compress As Double
compress = 0.000245858
Dim compressibility As Double
compressibility = Int(compress * 10 ^ -(Int(Log(Abs(compress))) - 3)) / 10 ^ -(Int(Log(Abs(compress))) - 3)
Debug.Print compressibility
End Sub
To make a long story short, the place where I work measures time by quadrants of a clock. For instance, 1.1 is an hour and 0-15 minutes, 1.2 is an hour and 15-30 minutes, and 1.3 is an hour and 30-45 minutes. There is no 1.4 because 1.4 is of course equal to 2.
I wanted to make an excel sheet that would automatically add my time under this system, so I wrote this UDF to convert the times by separating the decimal values and multiplying by 2.5 to get a normal decimal value (.1 = .25, .2 = .5, .3 = .75) and then dividing by 2.5 at the end to convert back to my employer's format. I'm aware that it can be done using excel's existing formulas, but is is kind of messy and to be honest I'm too stubborn to let this go now.
If you look at the screenshot below you'll see that the function works for all of the columns except the final weekly total column for some reason which displays 39.4 instead of 40 (again the two values are technically equivalent, but the program is not converting the .4 into a 1 for some reason).
http://i.imgur.com/yxOvlkP.png
Here is the code in it's entirety. The problem seems to occur when the remainder becomes equal to exactly 1 (for simplicity just imagine that two values ending .2 are entered) and then is rounded to zero somehow at the end.
Function newMath(week As Range) As Double
Dim time As Variant
Dim remainder As Double
Dim wholeTime As Double
remainder = 0
wholeTime = 0
For Each time In week
remainder = remainder + ((time - WorksheetFunction.RoundDown(time, 0)) * 2.5) 'Separate and sum up decimal values
wholeTime = wholeTime + WorksheetFunction.RoundDown(time, 0) 'Separate and sum up whole hours
Next time
'Problem occurs at this point when remainder = 1
'WorksheetFunction.RoundDown(remainder, 0) will equal 0 below even when 1 should round down to 1
wholeTime = wholeTime + WorksheetFunction.RoundDown(remainder, 0) 'Add the whole remainder hours to whole time
remainder = (remainder - WorksheetFunction.RoundDown(remainder, 0)) / 2.5 'Get decimal value of remainder and convert back to quadrant
newMath = wholeTime + remainder
End Function
Somehow when the remainder equals exactly 1 excel's rounddown function seems to round it to 0.
That means that the following line does not add the 1 to the whole number times as it should:
wholeTime = wholeTime + WorksheetFunction.RoundDown(remainder, 0)
And that this line will return a 1 which gets divided by 2.5 when it shouldn't (which is where the .4 comes from):
remainder = (remainder - WorksheetFunction.RoundDown(remainder, 0)) / 2.5
I'm not exactly sure what's going on or why excel is rounding my remainder of 1 to 0 if that is indeed the problem. I appreciate any help at all and let me know if you need any more information. Thanks!
Here's a slightly different way of doing things so as not to wind up with the 0.3999999 in place of the 4. Note that I used the VBA Int function which should execute more rapidly than the worksheetfunction.roundown(n,0).
By multiplying time * 10, and then, with the Mod function summing the last digit, we can do integer math until it is time to convert back to the final result.
Also note that the below routine is designed for positive numbers only. If you may be having negative numbers on your time sheet, you should use Fix in place of Int
Option Explicit
Function newMath(week As Range) As Double
Dim time As Range
Dim remainder As Variant
Dim wholeTime As Long
remainder = 0
wholeTime = 0
For Each time In week
wholeTime = wholeTime + Int(time)
remainder = remainder + (time * 10) Mod 10
Next time
'Problem occurs at this point when remainder = 1
'WorksheetFunction.RoundDown(remainder, 0) will equal 0 below even when 1 should round down to 1
wholeTime = wholeTime + Int(remainder / 4) 'Add the whole remainder hours to whole time
remainder = ((remainder / 4) - Int(remainder / 4)) / 2.5 'Get decimal value of remainder and convert back to quadrant
newMath = wholeTime + remainder
End Function
Try this code:
Function newMath(Rng As Range) As Double
Dim CL As Range
Dim hs As Long, hs1 As Long
Dim ms As Double, ms1 As Double, ms2 As Double
For Each CL In Rng
hs = hs + Fix(CL.Value)
ms = ms + CL.Value
Next
ms1 = Round((ms - hs), 1)
hs1 = Fix(ms1 / 0.4)
ms2 = ms1 - (hs1 * 0.4)
newMath = hs + hs1 + ms2
End Function
I'll try and keep this as basic and to the point as possible.
Basically, I have weights/probabilities associated with a certain range of numbers. For example :
0: 10%
1: 50%
2: 15%
3: 25%
This then translates into cumulative probabilities :
0: 10%
1: 60%
2: 75%
3: 100%
Using a uniform RNG in VBA, the program generates numbers between 0 and 1, or whatever inferior limit it is set to. Using the same values as the previous example, but only generating numbers greater than 60% (and <= 100%), this results in numbers between 0.6 - 1.0.
This is where I'm stuck. I need to convert these random numbers very efficiently into their "corresponding values".
All of it is stored in VBA variables and needless to say, I don't want to have to write a Select Case for every situation since they're actually 120 different variables and weights.
As of right now, this is what I have to generate those numbers:
RandomNumber = LowerLimit + Rnd() * (1 - LowerLimit)
Thanks is advance for all your help! If I missed a post that was discussing this particular issue please feel free to refer me to it but I really didn't find anything relating to corresponding random numbers.
Place the following function into a public module. You would call it like so mynumber = WeightedRnd(Array(0, 1, 2, 3), Array(0.1, 0.5, 0.15, 0.25)).
Public Function WeightedRnd(values As Variant, weights As Variant) As Double
'First, calculate the cumulative weights
Dim cumulativeWeight As Double
For i = 0 To UBound(weights)
weights(i) = weights(i) + cumulativeWeight
cumulativeWeight = weights(i)
Next
'Next, generate our random number
Dim randomNumber As Double
randomNumber = Rnd()
'Finally, figure out which "bucket" it falls into
For i = 0 To UBound(weights)
If randomNumber <= weights(i) Then
WeightedRnd = values(i)
Exit Function
End If
Next
End Function