Access

Rounding Functions (nearest decimal / nearest multiple)

Ease of Use

Easy

Version tested with

97, 2002, 2003 

Submitted by:

Cosmos75

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:

instructions for use

			

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:

vbaRounding97-2000.zip 42.16KB 

Approved by mdmackillop


This entry has been viewed 177 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express