Excel vba automatically adjusting axis

michaelg2708

New Member
Joined
Apr 11, 2018
Messages
7
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

Code:
[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]
 
Last edited by a moderator:

Tania Mofflin

New Member
Joined
Dec 9, 2020
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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.

Code:
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!

 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Watch MrExcel Video

Forum statistics

Threads
1,129,513
Messages
5,636,780
Members
416,939
Latest member
Rajakumaran

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top