Compare double in VBA precision problem - excel

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

Related

Why is this IF statement not working correctly? The values of the variables in the immediate window show that it should be working [duplicate]

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

How do you correct incorrect multiplication in Excel VBA (automatic round down/missing decimals)? [duplicate]

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

vba Fix function, double comparisons returning unexpected value

Fix function in vba is returning 2 when 3 is passed:
Debug.Print (Fix(Log(1000) / Log(10)))
--> This prints 2 instead of 3
Why is that?
Log(1000)/Log(10) or 6.90775527898214 รท 2.30258509299405 should be equal to 3 but it appears that the 15 digit floating point precision is generating a 15 digit precision floating point error and Fix is trucating off all of the decimal. If you Round to 15 decimal places to remove the infinitesimally small error, you will receive 3 as your answer.
?round(log(1000)/log(10), 15)
Debug.Print Log(1000) '6.90775527898214
Debug.Print Log(10) '2.30258509299405
6.90775527898214
/
2.30258509299405
=2.999999999999996 'VBA is convering this to '3#'
Debug.Print Fix(3#) '2
Debug.Print Round(Fix(Log(1000) / Log(10))) '2
Debug.Print Round(Round(Fix(Log(1000)) / Round(Log(10)))) '3 (This is what you want)
Debug.Print (Round(Fix(Log(1000)) / Round(Log(10)))) '3 (Or may be only this)
Doing a debug on the Log function:
Public Sub Test()
Dim number As Double
number = Log(1000)
Debug.Print number
End Sub
prints: 6.90775527898214
And
Public Sub Test()
Dim number As Double
number = Log(10)
Debug.Print number
End Sub
prints: 2.30258509299405
when you divide those you get: 2.(a lot of 9's) and calling Fix on that number will give you 2 not 3.
Hm - I think this is how VB handles Log vs how the worksheet function handles it. Using this, I get 3:
Debug.Print fix(worksheetfunction.log10(1000)/worksheetfunction.log10(10))
I remembered I had a similar issue with Logs, and asked about it on SO, so perhaps it's a related issue here.
When you work with floating-point numbers (Single Data Type (Visual
Basic) and Double Data Type (Visual Basic)), remember that they are
stored as binary fractions. This means they cannot hold an exact
representation of any quantity that is not a binary fraction (of the
form k / (2 ^ n) where k and n are integers). For example, 0.5 (= 1/2)
and 0.3125 (= 5/16) can be held as precise values, whereas 0.2 (= 1/5)
and 0.3 (= 3/10) can be only approximations.
https://msdn.microsoft.com/en-us/library/ae382yt8.aspx
So what I did is created another fix function which looks like this:
'fix has issues with
Public Function FixModified(ByVal x As Double, ByVal threshold As Double)
If Fix(x) = x Then
FixModified = x
ElseIf Fix(x) + 1 - x < threshold Then
FixModified = Fix(x) + 1
Else
FixModified = Fix(x)
End If
End Function
The threshold I am passing now is 0.000000000001 and it is working as expected.

Truncating Double with VBA in excel

I need to truncate the amount of decimal places of my double value for display in a textbox. How would one achieve this with vba?
If you want to round the value, then you can use the Round function (but be aware that VBA's Round function uses Banker's rounding, also known as round-to-even, where it will round a 5 up or down; to round using traditional rounding, use Format).
If you want to truncate the value without rounding, then there's no need to use strings as in the accepted answer - just use math:
Dim lDecimalPlaces As Long: lDecimalPlaces = 2
Dim dblValue As Double: dblValue = 2.345
Dim lScale = 10 ^ lDecimalPlaces
Dim dblTruncated As Double: dblTruncated = Fix(dblValue * lScale) / lScale
This yields "2.34".
You can either use ROUND for FORMAT in VBA
For example to show 2 decimal places
Dval = 1.56789
Debug.Print Round(dVal,2)
Debug.Print Format(dVal,"0.00")
Note: The above will give you 1.57. So if you are looking for 1.56 then you can store the Dval in a string and then do this
Dim strVal As String
dVal = 1.56789
strVal = dVal
If InStr(1, strVal, ".") Then
Debug.Print Split(strVal, ".")(0) & "." & Left(Split(strVal, ".")(1), 2)
Else
Debug.Print dVal
End If
You can use Int() function. Debug.print Int(1.99543)
Or Better:
Public Function Trunc(ByVal value As Double, ByVal num As Integer) As Double
Trunc = Int(value * (10 ^ num)) / (10 ^ num)
End Function
So you can use Trunc(1.99543, 4) ==> result: 1.9954
This was my attempt:
Function TruncateNumber(decimalNum As Double, decPlaces As Integer) As Double
'decimalNum: the input number to be truncated
'decPlaces: how many decimal places to round to. Use 0 for no decimal places.
decimalLocation = InStr(decimalNum, ".")
TruncateNumber = Left(decimalNum, decimalLocation + decPlaces)
End Function
It uses strings to avoid any math errors caused by different rounding methods. It will output as a type double, so you can still perform your own math on it.
This will cause an error if a number without a decimal place is passed into the above function. If this is a concern, you can use the following code instead:
Function TruncateNumber(decimalNum As Double, decPlaces As Integer) As Double
'decimalNum: the input number to be truncated
'decPlaces: how many decimal places to round to. Use 0 for no decimal places.
If InStr(decimalNum, ".") = 0 Then 'if there was no decimal:
'then return the number that was given
TruncateNumber = decimalNum
Else 'if there is a decimal:
'then return the truncated value as a type double
decimalLocation = InStr(decimalNum, ".")
TruncateNumber = Left(decimalNum, decimalLocation + decPlaces)
End If
End Function
Hopefully these functions are of some use to someone. I haven't done extensive testing, but they worked for me.
EDITED
Newer version of Excel (VBA) have a TRUNC function which already does things properly.
For older versions of EXCEL
I wanted to truncate a double into an integer.
value = Int(83.768)
value == 83
Awesome, it worked.
Depending on your version of Excel (VB) this might not work with negative numbers.
value = Int(-83.768)
value == -84
VB uses Banker rounding.
Public Function Trunc1(ByVal value As Double) As Integer
' Truncate by calling Int on the Absolute value then multiply by the sign of the value.
' Int cannot truncate doubles that are negative
Trunc1 = Sgn(value) * Int(Abs(value))
End Function
If you want specific decimal places do what Makah did only with Abs around the value so Int can truncate properly.
Public Function Trunc2(ByVal value As Double, Optional ByVal num As Integer = 1) As Double
' Truncate by calling Int on the Absolute value then multiply by the sign of the value.
' Int cannot truncate doubles that are negative
Trunc2 = Sgn(value) * (Int(Abs(value) * (10 ^ num)) / (10 ^ num))
End Function
Here is a little experiment I did... (1st time posting and answer, please tell me if I am not following conventions.
Sub Truncate()
Dim dblNum As Double
Dim intDecimal As Integer
dblNum = 1578.56789
intDecimal = 2 '0 returns 1578
'2 returns 1578.56
'-2 returns 1500
Debug.Print (Int(dblNum * 10 ^ intDecimal) / 10 ^ intDecimal)
End Sub

prime number in vba excel 2003

I'm analyzing a code from the website and I tried it on my side as well but seems it doesn't work. Could you please tell me why? would greatly appreciate your help.
Thanks
Private Sub CommandButton1_Click()
Dim N, D As Single
Dim tag As String
N = Cells(2, 2)
Select Case N
Case Is < 2
MsgBox "It is not a prime number"
Case Is = 2
MsgBox "It is a prime number"
Case Is > 2
D = 2
Do
If N / D = Int(N / D) Then
MsgBox "It is not a prime number"
tag = "Not Prime"
Exit Do
End If
D = D + 1
Loop While D <= N - 1
If tag <> "Not Prime" Then
MsgBox "It is a prime number"
End If
End Select
End Sub
The single biggest problem I see is using Single instead of Integer or Long. Primes are positive integers and are not thought of in the context of decimal values (as far as I know). Thus by using a singles and comparing them to divided ints, you're opening yourself up to nasty edge-case rouding errors.
The line If N / D = Int(N / D) Then is using a poor method to see whether or not the numbers are prime. It's assuming that every time you divide a floating point number (in this case, the single) by the divisor, if it has a decimal remainder, then the integer conversion of that remainder will not be equal. However, I've run into rounding errors sometimes with floating point numbers when trying to compare answers, and in general, I've learned to avoid using floating point to int conversions as a way of comparing numbers.
Here's some code you might try instead. Some things to note:
I've changed the types of N and D so that they are Longs and not Singles. This means they are not floating point and subject to possible rounding errors.
I've also explicitly converted the cell value to a long. This way you know in your code that you are not working with a floating point type.
For the comparison, I've used Mod, which returns the remainder of the N divided by D. If the remainder is 0, it returns true and we know we don't have a prime. (Note: Remainder is often used with \, which only returns the integer value of the result of the division. Mod and \ are commonly used in precise division of integer types, which in this case is very appropriate.
Lastly, I changed your message box to show the actual number being compared. Since the number in the cell is converted, if the user enters a floating point value, it will be good for them to see what it was converted to.
You'll probably also note that this code runs a lot faster than your code when you get to high numbers in the hundreds of millions.
'
Sub GetPrime()
Dim N As Long
Dim D As Long
Dim tag As String
N = CLng(Cells(2, 2))
Select Case N
Case Is < 2
MsgBox N & " is not a prime number"
Case Is = 2
MsgBox N & " is a prime number"
Case Is > 2
D = 2
Do
If N Mod D = 0 Then
MsgBox N & " is not a prime number"
tag = "Not Prime"
Exit Do
End If
D = D + 1
Loop While D <= N - 1
If tag <> "Not Prime" Then
MsgBox N & " is a prime number"
End If
End Select
End Sub
NOTE: I changed the name of the procedure to be GetPrime. In your code, you had:
Private Sub CommandButton1_Click()
In the line above, you are defining a procedure (also called a method or sometimes just referred to as a sub). The word Sub indicates you are defining a procedure in code that returns no value. (Sometimes you might see the word Function instead of Sub. This means the procedure returns a value, such as Private Function ReturnANumber() As Long.) A procedure (Sub) is a body of code that will execute when called. Also worth noting, an excel macro is stored in VBA as a Sub procedure.
In your line of code, CommandButton1_Click() is the name of the procedure. Most likely, this was created automatically by adding a button to an Excel spreadsheet. If the button is tied to the Excel spreadsheet, CommandButton1_Click() will execute each time the button is pressed.
In your code, Private indicates the scope of the procedure. Private generally means that the procedure cannot be called outside of the module or class in which it resides. In my code, I left out Private because you may want to call GetPrime from a different module of code.
You mentioned in your comments that you had to change the name of my procedure from GetPrime() to CommandButton1_Click(). That certainly works. However, you could also have simply called GetPrime from within CommandButton1_Click(), like below:
Private Sub CommandButton1_Click()
'The following line of code will execute GetPrime() '
'Since GetPrime does not have parameters and does not return a value, '
'all you need to do is put the name of the procedure without the () '
GetPrime
End Sub
'Below is the entire code for the Sub GetPrime() '
Sub GetPrime()
'The body of the code goes below: '
' ... '
End Sub
Hopefully this helped to explain a little bit about VBA to further your understanding!
I'm not sure where you copied this code from, but it's terribly inefficient. If I may:
Dim N, D As Long will cause D to be a Long, and N to be a variant. As you may know, variants are one of the slowest data types available. This line should be: Dim N As Long, D As Long
You only need to test every other number as an even number will always be divisible by two. (Therefore can not possibly be prime).
You don't need to test all the way up to N. You only need to test up to the Square Root of N. This is because after the square root the factors just switch sides, so you are just retesting values.
For Loops only evaluate the For-Line once for the life of the loop, but Do and While loops evaluate their conditional on every loop, so N-1 is being evaluated many, many times. Store this value in a variable if you want to use a Do Loop.
Ok, so now that we have dispensed with the blah, blah, blah, here is the code. I structured it so you can use it as a UDF from Excel as well (Ex: =ISPRIME(A2)):
Option Explicit
Sub GetPrime()
Dim varValue As Variant
varValue = Excel.ActiveSheet.Cells(2&, 2&).Value
If IsNumeric(varValue) Then
If CLng(varValue) = varValue Then
If IsPrime(varValue) Then
MsgBox varValue & " is prime", vbInformation, "Prime Test"
Else
MsgBox varValue & " is not prime", vbExclamation, "Prime Test"
End If
Exit Sub
End If
End If
MsgBox "This operation may only be performed on an integer value.", vbCritical, "Tip"
End Sub
Public Function IsPrime(ByVal num As Long) As Boolean
Dim lngNumDiv As Long
Dim lngNumSqr As Long
Dim blnRtnVal As Boolean
''//If structure is to optimize logical evaluation as AND/OR operators do not
''//use short-circuit evaluation in VB.'
If num = 2& Then
blnRtnVal = True
ElseIf num < 2& Then 'Do nothing, false by default.
ElseIf num Mod 2& = 0& Then 'Do nothing, false by default.
Else
lngNumSqr = Sqr(num)
For lngNumDiv = 3& To lngNumSqr Step 2&
If num Mod lngNumDiv = 0& Then Exit For
Next
blnRtnVal = lngNumDiv > lngNumSqr
End If
IsPrime = blnRtnVal
End Function
You can optimise it further (and make it more readable, in my opinion) by making the following changes. First performance:
Use longs, not floats. This will result in a huge speed increase.
You don't need to check up to n-1, only the square root of n. That's because if a factor d greater than sqrt(n) exists, its counterpart n/d would have already been found under sqrt(n). We use a special variable for this so that we don't get overflow by calculating divisor2. It also speeds it up by calculating that once rather than calculating the square every time through the loop (even though getting the square root is undoubtedly slower than squaring, it only happens once).
Do a special check first for multiples of two then you need only check that your number is a multiple of an odd number, effectively doubling the speed (not checking if you're a factor of a multiple of two).
Use the modulo operator rather than division/multiplication.
Now readability:
Use descriptive variable names.
Use a boolean for boolean values (not a string like tag).
Move the message box logic down to the bottom, based on the isPrime boolean, rather than scattering the messages amongst your code.
With all those changes, the following code can detect a 9-digit prime number (795,028,841) in well under a second. In fact, we can detect the largest 31-bit prime (2,147,483,647) in the same time.
Based on benchmarks (putting a 10,000-iteration for loop around the select), it takes 35 seconds on my box to detect that 31-bit prime. That's about 285 times per second - hopefully that'll be fast enough for you :-)
Option Explicit
Public Sub Go()
Dim number As Long
Dim divisor As Long
Dim maxdivisor As Long
Dim isPrime As Boolean
number = CLng(Cells(2, 2))
Select Case number
Case Is < 2
isPrime = False
Case Is = 2
isPrime = True
Case Is > 2
isPrime = True
If number mod 2 = 0 Then
isPrime = False
Else
maxdivisor = CLng(Sqr(number)) + 1
divisor = 3
Do
If number mod divisor = 0 Then
isPrime = False
Exit Do
End If
divisor = divisor + 2
Loop While divisor <= maxdivisor
End If
End Select
If isPrime Then
MsgBox "Number (" & number & ") is prime"
Else
MsgBox "Number (" & number & ") is not prime"
End If
End Sub

Resources