Question

I made this subroutine a while ago as I was dissatisfied with Excel’s auto-scaling for charts. The built-in Excel method works to an extent but when the range of the chart data gets a bit wider it just sets the minimum scale to 0 which can result in very squished lines with loads of blank space beneath it. Like below…

The code I wrote attempts to improve on excel’s method by choosing a suitable max and min limit for the y-axis based on the data in the chart. It works OK but sometimes chooses not-the-best values. Here is the result from my code applied to the same chart:

Here it has fit all the data in the plot area so it is quite clear to see but the values it chose aren’t the best. A human can look at this data and quickly assess that 90 and 140 are probably the best limits to use in this example but I’ve had trouble writing a script to do the same.

Here is the entire sub. It’s not too long. I’d appreciate any suggestions to improve the calculation of the limits…

Sub ScaleCharts()
'
' ScaleCharts Macro
'
Dim objCht As ChartObject
Dim maxi As Double, mini As Double, Range As Double, Adj As Double, xMax As Double, xMin As Double
Dim Round As Integer, Order As Integer, x As Integer, i As Integer

Application.ScreenUpdating = False
For x = 1 To ActiveWorkbook.Sheets.Count
Application.StatusBar = "Crunching sheet " & x & " of " & ActiveWorkbook.Sheets.Count

For Each objCht In Sheets(x).ChartObjects
  If objCht.Chart.ChartType = xlLine Or objCht.Chart.ChartType = xlXYScatter Then
  With objCht.Chart
  For i = 0 To .SeriesCollection.Count - 1 'Loop through all the series in the chart

            'Get the Max and Min values of the data in the chart
            maxi = Application.max(.SeriesCollection(i + 1).Values)
            mini = Application.min(.SeriesCollection(i + 1).Values)
            Range = maxi - mini

            If Range > 1 Then
                Order = Len(Int(Range))
                Adj = 10 ^ (Order - 2)
                Round = -1 * (Order - 1)
            ElseIf Range <> 0 Then
                Order = Len(Int(1 / Range))
                Adj = 10 ^ (-1 * Order)
                Round = Order - 1
            End If

            'Get the Max and Min values for the axis based on the data
            If i = 0 Or WorksheetFunction.Round(maxi, Round + 1) + Adj > xMax Then
            xMax = WorksheetFunction.Round(maxi, Round + 1) + Adj
            End If

            If i = 0 Or WorksheetFunction.Round(mini, Round + 1) - Adj < xMin Then
            xMin = WorksheetFunction.Round(mini, Round + 1) - Adj
            End If

       Next i

     With .Axes(xlValue)
        .MaximumScale = xMax
        .MinimumScale = xMin
     End With
  End With
  End If
Next objCht
Next x
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

EDIT: Here are the results of qPCR4vir’s changes…

Before

After

The last 2 charts get cut off as they do not exceed -100

Answer 1

The idea of using what Excel calculate: MajorUnit is good (assuming is allways rigth!! need to be proof). Now the round function you are looking for is:

tryxMax = Sgn(maxi) * WorksheetFunction.MRound(Abs(maxi + maju / 2.001), maju)
tryxMin = Sgn(mini) * WorksheetFunction.MRound(Abs(mini - maju / 2.001), maju)

It work for all nummers, small or negative inclusive.