CODEWITHSUNDEEP
vbams-access
Luca Guarro
Luca Guarro

Reputation: 1168

How to properly compare doubles in VBA

I have been getting a very simple yet strange bug. I have a textbox which displays the sum of a certain field in a table of my database. If the sum equals 1, I want to set the the textbox's border to green. If it is greater, I want to make it red. If less, grey. This is my code

  Private Sub calcSumRelativeRatios()
     Dim val As Double
     val = DSum("RelativeRatio", "ASCs")
     Me.sumTextBox.Value = val
     If val > 1 Then
        Me.sumTextBox.BorderColor = vbRed
     ElseIf val = 1 Then
        Me.sumTextBox.BorderColor = vbGreen
     Else
        Me.sumTextBox.BorderColor = 16
     End If
  End Sub

Sometimes, even when the sum is 1 (i.e. val is 1), it enters the first if condition and makes the border red. To me this seems like a VBA bug but maybe it's because I am comparing two different primitive types.

Could someone explain to me why 1 > 1 is True?

Upvotes: 0

Views: 2257

Answers (3)

Erik A
Erik A

Reputation: 32682

While the answer of Comintern is reasonable for most cases, it has some issues. For one, the delta should be relative to one of the measured values (bigger values have bigger inaccuracies for doubles). For this specific case, it'll do, since you're always comparing to 1.

Also, it's a good plan to move this to a separate function, since you might be comparing in multiple locations in your code, or in SQL.

I personally use this function to compare values that might be doubles. Note that it executes a strict comparison: it returns false if the variable types are inequal.

Public Function DblSafeCompare(ByVal Value1 As Variant, ByVal Value2 As Variant) As Boolean
    'Compares two variants, dates and floats are compared at high accuracy
    Const AccuracyLevel As Double = 0.00000001
    'We accept an error of 0.000001% of the value
    Const AccuracyLevelSingle As Single = 0.0001
    'We accept an error of 0.0001 on singles
    If VarType(Value1) <> VarType(Value2) Then Exit Function 'No typecasting! Both values should have equal type!
    Select Case VarType(Value1)
        Case vbSingle
            DblSafeCompare = Abs(Value1 - Value2) <= (AccuracyLevelSingle * Abs(Value1))
        Case vbDouble
            DblSafeCompare = Abs(Value1 - Value2) <= (AccuracyLevel * Abs(Value1))
        Case vbDate 'Dates are really doubles
            DblSafeCompare = Abs(CDbl(Value1) - CDbl(Value2)) <= (AccuracyLevel * Abs(CDbl(Value1)))
        Case vbNull 'Note: you might want to set it to false here. I like Null = Null leading to Tru
            DblSafeCompare = True
        Case Else
            DblSafeCompare = Value1 = Value2
    End Select
End Function

Implement it:

 Private Sub calcSumRelativeRatios()
     Dim val As Double
     val = DSum("RelativeRatio", "ASCs")
     Me.sumTextBox.Value = val
     If val > 1 And Not DblSafeCompare(val, 1#) Then 'Greater than 1 and not equal to 1
        Me.sumTextBox.BorderColor = vbRed
     ElseIf DblSafeCompare(val, 1#) Then '# = constant double, required
        Me.sumTextBox.BorderColor = vbGreen
     Else
        Me.sumTextBox.BorderColor = 16
     End If
  End Sub

Upvotes: 2

Gustav
Gustav

Reputation: 55951

While these explanations are correct, they don't address the main cause for your trouble which is, that you have chosen the wrong data type for the purpose.

The simple solution is:

Dim val As Currency

and your original and plain code will work as expected.

Upvotes: 0

Comintern
Comintern

Reputation: 22205

Without going too far into the details, floating point numbers are vulnerable to precision errors. Wikipedia has a pretty good explanation of how and why these occur. A good way to account for this error is to subtract the target values and test to see if they fall under a "delta" value, or acceptable precision for the equity check.

For example, if you're good with assuming that differences of .00000001 should be treated as equal, your test would look something like this:

Private Sub calcSumRelativeRatios()
    Const delta As Double = 0.00000001
    Dim val As Double
    val = DSum("RelativeRatio", "ASCs")
    Me.sumTextBox.Value = val
    If Abs(1 - val) < delta Then
        Me.sumTextBox.BorderColor = vbGreen
    ElseIf val > 1 Then
        Me.sumTextBox.BorderColor = vbRed
    Else
        Me.sumTextBox.BorderColor = 16
    End If
End Sub

Upvotes: 2

Related Questions