Excel vba automatically adjusting axis

[michaelg2708]

I use the below code to automatically adjust my axis on all my charts to the maximum and minimum on the chart when c2 changes and it works great but it only works on the primary axis. Is there any way to change it so it works on both the primary and secondary axis. Thanks

[COLOR=#252C2F][FONT=Helvetica]Sub AdjustVerticalAxis()[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]'PURPOSE: Adjust Y-Axis according to Min/Max of Chart Data[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]Dim cht As ChartObject[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]Dim srs As Series[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]Dim FirstTime As Boolean[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]Dim MaxNumber As Double[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]Dim MinNumber As Double[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]Dim MaxChartNumber As Double[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]Dim MinChartNumber As Double[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]Dim Padding As Double[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]'Input Padding on Top of Min/Max Numbers (Percentage)[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]Padding = 0.1 'Number between 0-1[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]'Optimize Code[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]Application.ScreenUpdating = False[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]'Loop Through Each Chart On ActiveSheet[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]For Each cht In ActiveSheet.ChartObjects[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]'First Time Looking at This Chart?[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]FirstTime = True[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]'Determine Chart's Overall Max/Min From Connected Data Source[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]For Each srs In cht.Chart.SeriesCollection[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]'Determine Maximum value in Series[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]MaxNumber = Application.WorksheetFunction.Max(srs.Values)[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]'Store value if currently the overall Maximum Value[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]If FirstTime = True Then[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]MaxChartNumber = MaxNumber[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]ElseIf MaxNumber > MaxChartNumber Then[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]MaxChartNumber = MaxNumber[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]End If[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]'Determine Minimum value in Series (exclude zeroes)[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]MinNumber = Application.WorksheetFunction.Min(srs.Values)[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]'Store value if currently the overall Minimum Value[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]If FirstTime = True Then[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]MinChartNumber = MinNumber[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]ElseIf MinNumber < MinChartNumber Or MinChartNumber = 0 Then[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]MinChartNumber = MinNumber[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]End If[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]'First Time Looking at This Chart?[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]FirstTime = False[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]Next srs[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]'Rescale Y-Axis[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]cht.Chart.Axes(xlValue).MinimumScale = MinChartNumber * (1 - Padding)[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]cht.Chart.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]Next cht[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]'Optimize Code[/FONT][/COLOR]
[COLOR=#252C2F][FONT=Helvetica]Application.ScreenUpdating = True[/FONT][/COLOR]

[COLOR=#252C2F][FONT=Helvetica]End Sub[/FONT][/COLOR]

 

[Tania Mofflin]

It broke on charts where you don't have a secondary axis. This update error handles that by not trying to set a non existant parameter.

Sub test()




Dim cht As ChartObject
Dim srs As Series
Dim FirstTime_P As Boolean
Dim FirstTime_S As Boolean
Dim MaxNumber As Double
Dim MinNumber As Double
Dim MaxChartNumber_P As Double
Dim MaxChartNumber_S As Double
Dim MinChartNumber_P As Double
Dim MinChartNumber_S As Double
Dim Padding As Double




'Input Padding on Top of Min/Max Numbers (Percentage)
Padding = 0.1 'Number between 0-1




'Optimize Code
Application.ScreenUpdating = False




'Loop Through Each Chart On ActiveSheet
For Each cht In ActiveSheet.ChartObjects




    'First Time Looking at This Chart?
    FirstTime_P = True
    FirstTime_S = True
   
    'Determine Chart's Overall Max/Min From Connected Data Source
    For Each srs In cht.Chart.SeriesCollection
        'Determine Maximum value in Series
        MaxNumber = Application.WorksheetFunction.Max(srs.Values)
       
        If srs.AxisGroup = xlPrimary Then
            'Store value if currently the overall Maximum Value
            If FirstTime_P = True Then
                MaxChartNumber_P = MaxNumber
            ElseIf MaxNumber > MaxChartNumber_P Then
                MaxChartNumber_P = MaxNumber
            End If




            'Determine Minimum value in Series (exclude zeroes)
            MinNumber = Application.WorksheetFunction.Min(srs.Values)




            'Store value if currently the overall Minimum Value
            If FirstTime_P = True Then
                MinChartNumber_P = MinNumber
            ElseIf MinNumber < MinChartNumber_P Or MinChartNumber_P = 0 Then
                MinChartNumber_P = MinNumber
            End If
           
            'First Time Looking at This Chart?
            FirstTime_P = False




        ElseIf srs.AxisGroup = xlSecondary Then
            'Store value if currently the overall Maximum Value
            If FirstTime_S = True Then
                MaxChartNumber_S = MaxNumber
            ElseIf MaxNumber > MaxChartNumber_S Then
                MaxChartNumber_S = MaxNumber
            End If




            'Determine Minimum value in Series (exclude zeroes)
            MinNumber = Application.WorksheetFunction.Min(srs.Values)




            'Store value if currently the overall Minimum Value
            If FirstTime_S = True Then
                MinChartNumber_S = MinNumber
            ElseIf MinNumber < MinChartNumber_S Or MinChartNumber_S = 0 Then
                MinChartNumber_S = MinNumber
            End If
           
            'First Time Looking at This Chart?
            FirstTime_S = False
        End If
    Next srs




    'Rescale Y-Axis
    On Error Resume Next
    cht.Chart.Axes(xlValue, xlPrimary).MinimumScale = MinChartNumber_P * (1 - Padding)
    cht.Chart.Axes(xlValue, xlPrimary).MaximumScale = MaxChartNumber_P * (1 + Padding)
    cht.Chart.Axes(xlValue, xlSecondary).MinimumScale = MinChartNumber_S * (1 - Padding)
    cht.Chart.Axes(xlValue, xlSecondary).MaximumScale = MaxChartNumber_S * (1 + Padding)
    On Error GoTo 0


Next cht




'Optimize Code
Application.ScreenUpdating = True




End Sub

I've actually just found this post suggesting that VBA may not work for Chart Type xlWaterfall. This is unfortunate!

Are the six new chart types in Excel 2016 programmable using VBA?

Microsoft appears to have included 6 new chart types - such as the xlWaterfall chart type - in Excel 2016 without the ability to program them using VBA (or .NET). More specifically: It seems necessary

answers.microsoft.com