Order of Magnitude Rounding

[Judd]

Is there a clever algorithm for rounding a number by order of magnitude?

I'm trying to set the axis bounds on a chart control such that if, for example,

max Y = 5637, max axis Y = 6000
min Y = 2312, min axis Y = 2000

I'd guess I'd also want to round up and down to the largest order of magnitude. Thus:

max Y = 5637, max axis Y = 6000
min Y = 134, min axis Y = 0 (i.e. not 100).

[si_the_geek]

How's this?

max_len = 10^(len(maxY)-1)
max_axisY = -int(-maxy/max_len) * max_len   ' using Int with -ve to round up!
min_axisY = int(miny/max_len) * max_len

[krtxmrtz]

Here's a subroutine I have used with success (probably it will have to be somewhat modified to suit your needs). I'm not sure it works quite "foolproof",I think there's an error with negative numbers...
I am attaching a demo project.

Btw the variables' names are not too explicit as to their meaning, as I'm using an old (with a limited number of characters per variable name) Fortran routine that I converted almost literally.

Public Sub RoundToNearest(zs)
'Given a number zs (of single type), another number is calculated
'of similar order of magnitude but "rounded up to the nearest number
'of a series a(i) or one of their multiples or submultiples
'The numbers a(1), a(2), ... are up to the user's taste
'I have chosen 1, 2 and 5, so that my rounded number
'will be one in the series 1, 2, 5, 10, 20, 50, 100, 200, 500, ...
'or 0.1, 0.2, 0.5, 0.01, 0.02, 0.05, ...
 
'The result is placed in zs so the original is destroyed
'(i.e. work with a copy)
 
    Dim a(1 To 3) as integer
    Dim zs as single
 
    a(1) = 1: a(2) = 2: a(3) = 5
 
    For i = 1 To 3
        If zs = a(i) Then Exit Sub
    Next
    jsign = Sgn(zs - 1)
    lex = (jsign - 1) \ 2
    f = 10 ^ lex
Start:
    For k = 1 To 3
        kk = k + 1
        ff = f
        If k = 3 Then
            kk = 1
            ff = 10 * ff
        End If
        a1 = a(k) * f
        a2 = a(kk) * ff
        If zs < a1 Or zs > a2 Then GoTo Endloop
        If zs = a1 Or zs = a2 Then Exit Sub
        d1 = Abs(zs - a1)
        d2 = Abs(zs - a2)
        zs = a2
        If d1 < d2 Then zs = a1
        Exit Sub
Endloop:
    Next
    f = f * 10 ^ jsign
    GoTo Start
End Sub

[Judd]

The simplest and most flexible method?

Format numbers in scientific notation:

4678 = 4.678x10³

Round up (or down) the mantissa?

The trick would be acquiring the mantisssa?

We can get the exponent from

Int(log10(4678)) ~ Int(3.67) = 3

[Judd]

Option Explicit
 
Private Sub Command1_Click()
    Dim dTest As Double
    Dim dExp As Double
    Dim dOrder As Double
    Dim dMantissa As Double
    Dim dRoundedUp As Double
    Dim dRoundedDown As Double
    
    dTest = 4678#
    dExp = Int(Log10(dTest))
    dOrder = 10 ^ dExp
    
    dMantissa = dTest / dOrder
    
    dRoundedUp = Ceil(dMantissa) * dOrder
    dRoundedDown = Floor(dMantissa) * dOrder
End Sub
 
Static Function Log10(x As Double) As Double
   Log10 = Log(x) / Log(10#)
End Function
 
Function Ceil(x As Double) As Double
    If Round(x) = x Then
        Ceil = x
    Else
        Ceil = Round(x + 0.5)
    End If
End Function
 
Function Floor(x As Double) As Double
    If Round(x) = x Then
        Floor = x
    Else
        Floor = Round(x - 0.5)
    End If
End Function

[Judd]

Private Sub Command1_Click()
    Dim dTest As Double
    Dim dRoundedUp As Double
    Dim dRoundedDown As Double
    dTest = 0.001234
    dRoundedUp = MagnitudeRound(dTest, True)
    dRoundedDown = MagnitudeRound(dTest, False)
End Sub
 
Function MagnitudeRound(dNumber As Double, Optional bRoundUp As Boolean = True, Optional nOrder As Variant) As Double
    Dim dOrder As Double
    Dim dMantissa As Double
    
    If IsMissing(nOrder) Then
        nOrder = Int(Log(dNumber) / Log(10#))
    End If
    
    dOrder = 10 ^ nOrder
    
    dMantissa = dNumber / dOrder
    
    If (bRoundUp) Then
        MagnitudeRound = Ceil(dMantissa) * dOrder
    Else
        MagnitudeRound = Floor(dMantissa) * dOrder
    End If
    
End Function
 
Function Ceil(x As Double) As Double
    If Round(x) = x Then
        Ceil = x
    Else
        Ceil = Round(x + 0.5)
    End If
End Function
 
Function Floor(x As Double) As Double
    If Round(x) = x Then
        Floor = x
    Else
        Floor = Round(x - 0.5)
    End If
End Function

[si_the_geek]

Originally posted by Judd

Private Sub Command1_Click()
    Dim dTest As Double
    Dim dRoundedUp As Double
    Dim dRoundedDown As Double
    dTest = 0.001234
    dRoundedUp = MagnitudeRound(dTest, True)
    dRoundedDown = MagnitudeRound(dTest, False)
End Sub
 
Function MagnitudeRound(dNumber As Double, Optional bRoundUp As Boolean = True, Optional nOrder As Variant) As Double
    Dim dOrder As Double
    Dim dMantissa As Double
    
    If IsMissing(nOrder) Then
        nOrder = Int(Log(dNumber) / Log(10#))
    End If
    
    dOrder = 10 ^ nOrder
    
    dMantissa = dNumber / dOrder
    
    If (bRoundUp) Then
        MagnitudeRound = Ceil(dMantissa) * dOrder
    Else
        MagnitudeRound = Floor(dMantissa) * dOrder
    End If
    
End Function
 
Function Ceil(x As Double) As Double
    If Round(x) = x Then
        Ceil = x
    Else
        Ceil = Round(x + 0.5)
    End If
End Function
 
Function Floor(x As Double) As Double
    If Round(x) = x Then
        Floor = x
    Else
        Floor = Round(x - 0.5)
    End If
End Function

Great code, but not relevant here.. the min value should round to the same order of magnitude of the max value
max =5637 should round to 6000 - fine
min = 134 should round to 0 - yours would round this to 100

try this code in your command button:

Dim maxy As Long, miny As Long
maxy = 5637
miny = 134
    dRoundedUp = MagnitudeRound(CDbl(maxy), True)
    dRoundedDown = MagnitudeRound(CDbl(miny), False)
 
max_len = 10 ^ (Len(maxy) - 1)
max_axisY = -Int(-maxy / max_len) * max_len 
min_axisY = Int(miny / max_len) * max_len
 
Msgbox "Max:   " & vbtab & dRoundedUp & vbtab & " or " & max_axisY  & vbcr _
          & "Min:   " & vbtab & dRoundedDown & vbtab & " or " & min_axisY

[Judd]

That's why I included the order as an argument, you can specify the order to round to:

dTest = 123
dRoundedUp = MagnitudeRound(dTest, True) = 200
dRoundedDown = MagnitudeRound(dTest, False) = 100

dTest = 123
dRoundedUp = MagnitudeRound(dTest, True, 1) = 130
dRoundedDown = MagnitudeRound(dTest, False, 1) = 120

dTest = 123
dRoundedUp = MagnitudeRound(dTest, True, 2) = 200
dRoundedDown = MagnitudeRound(dTest, False, 2) = 100

dTest = 123
dRoundedUp = MagnitudeRound(dTest, True, 3) = 1000
dRoundedDown = MagnitudeRound(dTest, False, 3) = 0

Makes the function more flexible