Rounding up numbers depending on their value (1 Viewer)

PhilUp

Registered User.
Local time
Today, 03:41
Joined
Mar 4, 2015
Messages
60
Hi,

I have been searching and struggling with this for a while. I am looking to Round Up numbers as in Excel. I know Int function can be used as follow:

Int(100 * [MyField]) / 100

Works well, however I want to have different roundings depending on the numbers.

if value is between 0 and 1000, round up to 10
if value is between1000 and 10,000, round up to 100
if value is between 10,000 and 100,000, round up to 1000
etc

I have tried to us IFF functions and nesting the INT() but it gives me an error saying that the formula id too complex.

I also tried to write some code to make a public function based on something like this:

Public Function GlblRoundup(wNumber As Currency, wDecPlaces As Integer) As Currency
Dim wResult As Currency
Dim wFactor As Currency

Select Case wDecPlaces
Case 0
wFactor = -1
Case 1
wFactor = -10
Case 2
wFactor = -100
Case 3
wFactor = -1000
Case 4
wFactor = -10000
Case Else
wFactor = -10000
End Select

wResult = Int(wFactor * wNumber) / wFactor

GlblRoundup = Round(wResult, wDecPlaces)
End Function


But unsuccessful.
Would greatly appreciate if someone could help.
 

plog

Banishment Pending
Local time
Today, 05:41
Joined
May 11, 2011
Messages
11,653
Sorry, saw your message but only have 5 minutes to work on this today--so I can't provide exact solution just guidance.

I don't think Int is the function to use for this. You are going to want Round(https://www.techonthenet.com/access/functions/numeric/round.php). What you will do is divide your number by your factor to convert it to a decimal, then Round it, then multiply it by your factor to convert back to the number you want with the appropriate digits rounded. Int isn't part of this, you will get there by dividing, rounding, then multipying back.
 

PhilUp

Registered User.
Local time
Today, 03:41
Joined
Mar 4, 2015
Messages
60
Yes, I understand the Round function, but i am looking to round UP.

According to Allen Brown, he recommends the I
 

PhilUp

Registered User.
Local time
Today, 03:41
Joined
Mar 4, 2015
Messages
60
Hit the wrong key, sorry start again..

Yes, I understand the Round function, but i am looking to round UP.

According to Allen Brown, he recommends the INT function:

"
Rounding up
To round upwards towards the next highest number, take advantage of the way Int() rounds negative numbers downwards, like this:
*** - Int( - [MyField])
As shown above, Int(-2.1) rounds down to -3. Therefore this expression rounds 2.1 up to 3.
To round up to the higher cent, multiply by -100, round, and divide by -100:
*** Int(-100 * [MyField]) / -100
"
 

plog

Banishment Pending
Local time
Today, 05:41
Joined
May 11, 2011
Messages
11,653
Give me some examples. Actually, let me provide the examples and you give me what you expect:

.1 --> ?
112.3 --> ?
169 --> ?
1001.1 --> ?
12089.4 --> ?
 

Cronk

Registered User.
Local time
Today, 20:41
Joined
Jul 4, 2013
Messages
2,772
I had a requirement something similar a while back. I've modified it with the select coding to align with your situation. You can modify this to suit.
Code:
Function RoundNumber(pvar As Variant) As Variant
   If Not IsNumeric(pvar) Then
      RoundNumber = pvar
      Exit Function
   End If
   
   If pvar = 0 Then
      RoundNumber = 0
      Exit Function
   End If
   
   Dim n As Integer
   n = CInt(Log(pvar) / Log(10#) - 0.5) 'Gives the power of 10 for passed value
   Select Case n
      Case  1 or 2
         n = 1
      Case  3 or 4
         n = 3
      Case Else
         n = n
   End Select
      
   RoundNumber = ((pvar - 0.5) \ 10 ^ n + 1) * 10 ^ n
      
End Function

Note, you don't specify what happens at limits ie 1000
 

PhilUp

Registered User.
Local time
Today, 03:41
Joined
Mar 4, 2015
Messages
60
Hi GOP,

Sorry for my late reply, I had some emergency.

here are some samples:

.1 > .1
112.3 > 113
169 > 169
1001.1 > 1010
12089.4 > 12090
85675 > 85680
100654 > 100700
 

jdraw

Super Moderator
Staff member
Local time
Today, 06:41
Joined
Jan 23, 2006
Messages
15,378
I posted a function here that may help
 

plog

Banishment Pending
Local time
Today, 05:41
Joined
May 11, 2011
Messages
11,653
Your description and data don't jive:

Case A: if value is between 0 and 1000, round up to 10
Case B: if value is between 1000 and 10,000, round up to 100
Case C: if value is between 10,000 and 100,000, round up to 1000
...

Example 1: .1 > .1
Example 2: 112.3 > 113
Example 3: 169 > 169
Example 4: 1001.1 > 1010
Example 5: 12089.4 > 12090
Example 6: 85675 > 85680
Example 7: 100654 > 100700

Example 1 conflicts-->goes to Case A but not rounded to ten
Example 2 conflicts--> goes to Case A, but not rounded to ten
Example 3 conflicts--> goes to Case A, but not rounded to ten
Example 4 conflicts--> goes to Case B, but not rounded to hundred
Example 5 conflicts--> goes to case C, but not rounded to thousand
Example 6 conflicts--> goes to Case C, but not rounded to thousand
Example 7 undefined--> no matching case for number so large

Please verify the example data is correct and restate the cases correctly.
 

jdraw

Super Moderator
Staff member
Local time
Today, 06:41
Joined
Jan 23, 2006
Messages
15,378
Here is a sample select case, your general guides and the function I mentioned in previous post.

Code:
'---------------------------------------------------------------------------------------
' Procedure : PhilUpRnd
' Author    : mellon
' Date      : 06-Mar-2017
' Purpose   :
      'PhilUp plog  and Rounding
      'https://www.access-programmers.co.uk/forums/showthread.php?p=1524149#post1524149
      'Case A: if value is between 0 and 1000, round up to 10
      'Case B: if value is between 1000 and 10,000, round up to 100
      'Case C: if value is between 10,000 and 100,000, round up to 1000

'---------------------------------------------------------------------------------------
'
Sub PhilUpRnd()


      'The test data
      '.1
      '112.3
      '169
      '1001.1
      '12089.4
      '85675
      '100654
          Dim i As Integer
          Dim UpTo As Double
          Dim dArr(6) As Double
10       On Error GoTo PhilUpRnd_Error

20        dArr(0) = 0.1
30        dArr(1) = 112.3
40        dArr(2) = 169
50        dArr(3) = 1001.1
60        dArr(4) = 12089.4
70        dArr(5) = 85675
80        dArr(6) = 100654

90        For i = 0 To 6
100           Select Case dArr(i)
              Case 0.001 To 1000         'round to next 10
110               UpTo = 10
120           Case 1000.001 To 10000     'round up to next 100
130               UpTo = 100
140           Case 10000.001 To 100000   'round up to next 1000
150               UpTo = 1000
160           Case Else
170               Debug.Print i; dArr(i) & " is outside of range 0 - 100000"           'error in input
180               GoTo GetNext_i
190           End Select
200           Debug.Print i; dArr(i); GetRoundedTo(dArr(i), UpTo, 1) '1 represents up
GetNext_i:
210       Next i

220      On Error GoTo 0
230      Exit Sub

PhilUpRnd_Error:

240       MsgBox "Error " & err.number & " in line " & Erl & " (" & err.Description & ") in procedure PhilUpRnd of Module AWF_Related"
End Sub

Results using the test data
Code:
0  0.1  10 
 1  112.3  120 
 2  169  170 
 3  1001.1  1100 
 4  12089.4  13000 
 5  85675  86000 
 6 100654 is outside of range 0 - 100000
 

PhilUp

Registered User.
Local time
Today, 03:41
Joined
Mar 4, 2015
Messages
60
Hi JDraw,

Thank you so much for your help. Looks exactly right.
I am just confused with the lines 20 to 80. Now you have the test values, but how to get the value from [MyField] ?
 

jdraw

Super Moderator
Staff member
Local time
Today, 06:41
Joined
Jan 23, 2006
Messages
15,378
PhilUp,

The lines 20-80 you asked about in previous post are used to put test values into an array. It simplifies testing (in my view). I thought your concern initially was the logic of the Case, so tried to show a Select Case with some different values.

This post shows how to call a function to get the proper rounded value.
The link to GetRoundedTo function was given iin an earlier post.

Here is a function and a test routine.You can call the function to get the appropriate result.

Code:
Function PhilUpRnd2(Yourfield As Double) As Double
      'https://www.access-programmers.co.uk/forums/showthread.php?p=1524149#post1524149
      'Case A: if value is between 0 and 1000, round up to 10
      'Case B: if value is between 1000 and 10,000, round up to 100
      'Case C: if value is between 10,000 and 100,000, round up to 1000
      '
      '

    Dim i As Integer
    Dim UpTo As Double

10  On Error GoTo PhilUpRnd2_Error
20  If Not IsNumeric(Yourfield) Then
30      PhilUpRnd2 = 9999
40      GoTo PhilUpRnd2_Exit
50  End If
60  Select Case Yourfield
    Case 0.001 To 1000                 'round to next 10
70      UpTo = 10
80  Case 1000.001 To 10000        'round up to next 100
90      UpTo = 100
100 Case 10000.001 To 100000   'round up to next 1000
110     UpTo = 1000
120 Case Else
130     Debug.Print Yourfield & " is outside of range 0 - 100000"           'error in input
140     GoTo PhilUpRnd2_Exit
150 End Select
160 PhilUpRnd2 = GetRoundedTo(Yourfield, UpTo, 1)  '1 represents up

170
PhilUpRnd2_Exit:
180 On Error GoTo 0
190 Exit Function

PhilUpRnd2_Error:

200 MsgBox "Error " & err.number & " in line " & Erl & " (" & err.Description & ") in procedure PhilUpRnd2 of Module AWF_Related"
End Function

And here is the test routine.
Code:
Sub TestPhil()
Dim w As Double: w = 1056.9
Debug.Print PhilUpRnd2(w)
End Sub
 

PhilUp

Registered User.
Local time
Today, 03:41
Joined
Mar 4, 2015
Messages
60
Thanks a lot, will try it out soon and let you know.
 

PhilUp

Registered User.
Local time
Today, 03:41
Joined
Mar 4, 2015
Messages
60
Hi Jdraw,

I am getting error on line 160 - GetRoundedTo

Compile error:
Sub or Function not define

Can someone help on that ? Thank in advance.
 

jdraw

Super Moderator
Staff member
Local time
Today, 06:41
Joined
Jan 23, 2006
Messages
15,378
??? Almost 2 years since previous post???
The GetRoundedTo function is located at the link given in post #8 above.
 

PhilUp

Registered User.
Local time
Today, 03:41
Joined
Mar 4, 2015
Messages
60
yes, I am restarting my project now. Thanks for reply, It works great
 

Users who are viewing this thread

Top Bottom