Macro to update multiple Chart Sheets Y-Axis

[zman88]

Hi All,

I'm new to VBA and macros, but from what I understand, they should be able to help me with my issue.

I've got an excel file that has north of 200 charts that need to get updated monthly. The problem I'm running into is the scaling of the y-axis. I've found that excel's auto function for the axis parameters isn't always what I need. And instead of manually going into each chart and adjusting the axis (which probably would take an entire day), I've been looking for a macro that can do this for me and have been unable to find one thus far.

Is there a way to have a macro go through each chart in my workbook and find the min data point, and make the y-axis minimum 95% of that point (rounded to the nearest 10,000). Then find the max data point, and may the y-axis maximum 105% of that point (rounded to the nearest 10,000). And have the units be ((y_axis_max-y_axis_min)/10). And finally have this macro run when a button is clicked in the Chart Data Sheet?

I've attached a sample of the Charts and data that I am using.

Any help would be greatly appreciated!

[MatrixMan]

Try this in your button routine:

Sub ResetChartYAxis()
Dim wks As Worksheet
Dim cht As Chart
Dim rngFirstCell As Range, rngLastCell As Range, rngData As Range
Dim strFormula As String
Dim dblMin As Currency, dblMax As Currency

    For Each cht In ThisWorkbook.Charts
        'get first cell of source data:
        strFormula = cht.SeriesCollection(1).Formula
        Set rngFirstCell = Range(Split(strFormula, ",")(2))(1)
        'get last cell of source data:
        strFormula = cht.SeriesCollection(cht.SeriesCollection.Count).Formula
        With Range(Split(strFormula, ",")(2))
            Set rngLastCell = .Item(.Count)
        End With
        Set wks = ThisWorkbook.Worksheets(rngFirstCell.Parent.Name)
        'get the variance range:
        Set rngLastCell = rngLastCell.Offset(0, 1)
        Set rngFirstCell = wks.Cells(rngFirstCell.Row, rngLastCell.Column)
        Set rngData = wks.Range(rngFirstCell, rngLastCell)
        
        'find min/max values:
        dblMin = Application.WorksheetFunction.Min(rngData)
        dblMin = Round(dblMin / 10000) * 10000
        dblMax = Application.WorksheetFunction.Max(rngData)
        dblMax = Round(dblMax / 10000) * 10000
        'set axis to 10% over max / under min:
        cht.Axes(xlValue).MinimumScale = 0.9 * dblMin
        cht.Axes(xlValue).MaximumScale = 1.1 * dblMax
    Next cht
    
End Sub