 Access

Rounding Functions (nearest decimal / nearest multiple) Ease of Use

Easy

Version tested with

97, 2002, 2003

Submitted by:

Description:

These two functions are for rounding numbers. - vbaROUND() rounds a number to the nearest decimal spots you specify. - vbaROUNDTO() rounds a number to the nearest multiple you specify. Should be possible to use this function in other Office VBA code.

Discussion:

The ROUND() formula in Access VBA does not behave like the ROUND() you may be used to in an Excel worksheet. Try the following two in Access VBA; Round(2.5, 0) and Round(3.5, 0). You will find that the results are as follows; Round(2.5, 0) = 2 and Round(3.5, 0) = 4. The ROUND() function in VBA uses, Banker's rounding. That is, it rounds to the nearest even number. You can call the Round function from Excel using the following line in Access VBA -- [Application.WorksheetFunction.Round(Range(2.5), 0)]. But it is very simple to create and use a function in vba rather than to call Excel's ROUND function.

Code:

```			Option Compare Database
Option Explicit

Public Enum rOpt
rNearest
rUp
rDown
End Enum

'*****************************************************************
' ACCESS 97 Version
'
' Since Public Enums declarations are only available in Access 2000 and higher,
' make the following changes for Access 97
' 1) Change the Global declaration from
'
' Public Enum rOpt
'    rNearest
'    rUp
'    rDown
' End Enum
'
' TO
'
' Public Const rNearest As Integer = 1
' Public Const rUp  As Integer = 2
' Public Const rDown  As Integer = 3 ?
'
' 2) In function arguments declarations change the following
'
' Optional RoundingOption As Integer = rNearest
'
' to
'
' Optional RoundingOption As rOpt = rNearest
'
'*****************************************************************

Public Function vbaRound(dblValue As Double, intDecimals As Integer, _
Optional RoundingOption As rOpt = rNearest) As Double
Dim dblPlacesFactor As Double
Dim dlbRoundFactor As Double

If intDecimals < 0 Then
vbaRound = 0
Exit Function
End If

dblPlacesFactor = 10 ^ intDecimals

Select Case RoundingOption
Case rNearest 'Round to Nearest
dlbRoundFactor = 0.5
Case rUp 'Round UP
dlbRoundFactor = 1
Case rDown 'Round DOWN
dlbRoundFactor = 0
End Select

vbaRound = Int(dblValue * dblPlacesFactor + dlbRoundFactor) / dblPlacesFactor
End Function

Public Function vbaRoundTO(dblValue As Double, dblRoundTo As Double, _
Optional RoundingOption As rOpt = rNearest) As Double
Dim dblRoundedMutliple As Double
Dim dblValueDiv As Double
Dim dblValueNew As Double

'Set default retrun value if dblRoundTo = 0
If dblRoundTo = 0 Then
vbaRoundTO = 0 'OR vbaRoundTO = dblValue
Exit Function
End If

'Find multiple of RoundToSmallest
dblValueDiv = dblValue / dblRoundTo

'Option to RoundUP or RoundDOWN
Select Case RoundingOption
Case rNearest
'Round multiple to nearest
'DO NOT USE VBA Round() function.
'VBA : Round(2.5,0) = 2, i.e. rounds >=0.5 to 0 not 1
dblRoundedMutliple = vbaRound(dblValueDiv, 0)
Case rUp
'Round multiple UP
dblRoundedMutliple = vbaRound(dblValueDiv, 0, 1)
Case rDown
'Round multiple DOWN
dblRoundedMutliple = vbaRound(dblValueDiv, 0, 2)
Case Else
End Select

'Calculate new "rounded-to" value
dblValueNew = dblRoundedMutliple * dblRoundTo

'Return value
vbaRoundTO = dblValueNew

End Function

```

How to use:

1. Create a module
2. Give the name the module (e.g. basVbaRound)
3. Call the function in your VBA code

Test the code:

1. vbaRound() has 3 arguments, the third of which is optional.
2. The optional argument is for rounding UP or DOWN.
3. vbaRound(value, decimals places to round to, optional argument)
4. vbaRound(2.5, 0, 0) = 3 'Rounds to nearest
5. vbaRound(2.5, 0, 1) = 3 'Rounds UP
6. vbaRound(2.5, 0, 2) = 2 'Rounds DOWN
7. You use it like you would the vbaROUND() function but instead of specifying the number of decimals to round to, you specify the number you want to round to.
8. e.g.
9. vbaRoundTo(2.45, 0.25, 0) = 2.5 'Round to nearest
10. vbaRoundTo(2.45, 0.25, 1) = 2.5 'Round UP
11. vbaRoundTo(2.45, 0.25, 2) = 2.25 'Round DOWN

Sample File:

Approved by mdmackillop

This entry has been viewed 178 times.

Copyright @2004 - 2020 VBA Express