VBA - Picking Nice Graph Axes

Have you ever pondered writing your own chart logic? Unlikely if you use Excel VBA given Excel's excellent chart support. However, I have been looking at writing a XAML graph control but I wanted to road test some logic in VBA first. The first problem I encountered is how to pick nice numbers for your graph axis, the algorithm is not obvious and I had to google before I found a popular answer on Stack Overflow.

So below I have given a VBA equivalent, sort of. The original given code was quite classy when it needn't be given that we are not holding state. I think a functional implementation is more appropriate and so I have written the VBA as a series of functions for a standard module. Also, I wanted to call from the worksheet.

One other point to note is that I have been influenced by Python of late; in Python one can return a tuple from a function which is a plural of return values. In VBA, we can use the Array() function to pack values into an equivalent of a tuple, a one-dimensional variant array.

Option Explicit

'* with thanks to
'http://erison.blogspot.com/2011/07/algorithm-for-optimal-scaling-on-chart.html
'https://stackoverflow.com/questions/8506881/nice-label-algorithm-for-charts-with-minimum-ticks/16363437#16363437

Public Function CalculateNiceScale(ByVal dMin As Double, ByVal dMax As Double, Optional maxTicks As Long = 10)

    Dim tickSpacing As Double
    Dim range As Double
    Dim niceMin As Double
    Dim niceMax As Double
    Dim tickCount As Double

    range = niceNum(dMax - dMin, False)
    tickSpacing = niceNum(range / (maxTicks - 1), True)
    niceMin = Math_Floor(dMin / tickSpacing) * tickSpacing
    niceMax = Math_Ceiling(dMax / tickSpacing) * tickSpacing
    
    tickCount = (niceMax - niceMin) / tickSpacing
    
    CalculateNiceScale = Array(tickSpacing, niceMin, niceMax, tickCount, dMin, dMax, maxTicks)
    
End Function

Private Function Math_Floor(ByVal dIn As Double) As Double
    Math_Floor = Application.WorksheetFunction.Floor(dIn, 1)
End Function

Private Function Math_Ceiling(ByVal dIn As Double) As Double
    Math_Ceiling = Application.WorksheetFunction.Ceiling(dIn, 1)
End Function

Private Function Math_Log10(ByVal dIn As Double) As Double
    Math_Log10 = Log(Abs(dIn)) / Log(10)
End Function


Private Function niceNum(range As Double, round As Boolean) As Double
    Dim exponent As Double ' /** exponent of range */
    Dim fraction As Double ' /** fractional part of range */
    Dim niceFraction As Double ' /** nice, rounded fraction */

    exponent = Math_Floor(Math_Log10(Abs(range)))
    fraction = range / 10 ^ exponent

    If round Then
        If fraction < 1.5 Then
            niceFraction = 1
        ElseIf fraction < 3 Then
            niceFraction = 2
        ElseIf fraction < 7 Then
            niceFraction = 5
        Else
            niceFraction = 10
        End If
    Else
        If fraction <= 1 Then
            niceFraction = 1
        ElseIf fraction <= 2 Then
            niceFraction = 2
        ElseIf fraction <= 5 Then
            niceFraction = 5
        Else
            niceFraction = 10
        End If
    End If
    
    niceNum = niceFraction * 10 ^ exponent

End Function

Sub testCalculateNiceScale()
    Dim v
    v = CalculateNiceScale(-0.085, 0.173)
    PrintResults v
End Sub


Sub testCalculateNiceScale2()
    Dim v
    v = CalculateNiceScale(1.2813, 1.331, 8)
    PrintResults v

    v = CalculateNiceScale(1.2813, 1.331)
    PrintResults v
End Sub

Sub PrintResults(v)
    Debug.Print
    Debug.Print "min:" & v(4)
    Debug.Print "max:" & v(5)
    Debug.Print "maxTicks:" & v(6)
    Debug.Print "TickSpacing:" & v(0)
    Debug.Print "NiceMin:" & v(1)
    Debug.Print "NiceMax:" & v(2)
    Debug.Print "TickCount:" & CInt(v(3))
End Sub