Excel vba automatically adjusting axis

M

michaelg2708

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

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
This is a perfect use case of the macro recorder. I turned it on to change my axes and learned that the appropriate reference for the secondary axis is Chart.Axes(xlValue, xlSecondary).MaximumScale

Modify your existing code with the addition of those references.
 
Upvote 0
Thanks for the reply. Never used vba before so not sure if i am doing it right. I changed the code but it came up as an error. Is there anything else I have to add or do I just type that in
 
Upvote 0
Sorry, I saw your existing code and presumed you simply needed to know the mechanics of changing the scale.

To update your code, you need two things. The bounds you want to set the axes to, and then the lines that you apply it to the axes themselves.

Looking at your existing code, you bring in the bounds with the following:

Code: 
'Determine Maximum value in Series
MaxNumber = Application.WorksheetFunction.Max(srs.Values)

Code: 
'Determine Maximum value in Series
MaxNumber = Application.WorksheetFunction.Max(srs.Values)

This code is looking at ALL the values plotted in a given chart, and is pulling out the largest and smallest. That will make everything fit on a single axis chart. Now your desire is to scale the secondary axis. The question would be on what criteria you want to scale it? To scale it on the same as the primary would be pointless (since they would have the same scale), so you need to provide input on what criteria you want to scale on.

From there, it is relatively simple to pass the newly assigned min/max to the existing code section

Code: 
'Rescale Y-Axis
cht.Chart.Axes(xlValue).MinimumScale = MinChartNumber * (1 - Padding)
cht.Chart.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)

by adding underneath it:
Code: 
cht.Chart.Axes(xlValue, xlSecondary).MinimumScale = {NEW MIN SCALING VARIABLE} * (1 - Padding)
cht.Chart.Axes(xlValue, xlSecondary).MaximumScale = {NEW MAX SCALING VARIABLE} * (1 + Padding)
 
Upvote 0
Sorry for being stupid but im completely new at this. How do I provide input on what to scale it on? Is there a code that would pick it up automatically because it is on the secondary axis
 
Upvote 0
Try this on for size. It changes the search for min/max values in the loop through series objects to pull two different max/mins depending on whether the series is plotted on the look for max and min depending on which axis the series is plotted on.

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
    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)


Next cht


'Optimize Code
Application.ScreenUpdating = True


End Sub
 
Upvote 0
i get the message

Run-time error '-2147467259 (80004005)':
Method 'axes' of object'_Chart' failed

and it highlights the this line of code
cht.Chart.Axes(xlValue, xlSecondary).MinimumScale = MinChartNumber_S * (1 - Padding)
 
Upvote 0
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
 
Upvote 0
gmhumphr said:
Try this on for size. It changes the search for min/max values in the loop through series objects to pull two different max/mins depending on whether the series is plotted on the look for max and min depending on which axis the series is plotted on.

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
    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)


Next cht


'Optimize Code
Application.ScreenUpdating = True


End Sub
Click to expand...
Hi

I've seen a few versions of this around on various forums and I've tried 2 now that both fail on the line

MaxNumber = Application.WorksheetFunction.Max(srs.Values)

This actually works on a combo chart on the worksheet but fails on a waterfall chart and unfortunately it's waterfall charts I was wanting to get this working for.

Would you a) have any idea why it is failing on this line and b) how to make this run specifically for chart type waterfall?

Any help would be much appreciated. Thanks
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Question Question
Graph Axis
Replies
1
Views
318
NdNoviceHlp
NdNoviceHlp
Y
  • Solved
VBA to automatically adjust my Y-Axis
Replies
4
Views
4K
rlv01
R
T
  • Solved
Setting up Two Pie charts in VBA
Replies
4
Views
207
TheTiredEngineer
T
E
  • Question Question
Y axis vba code EDIT to adjust automatically instead of clicking
Replies
1
Views
2K
NdNoviceHlp
NdNoviceHlp
D
  • Question Question
Using VBA to determine Maximum Values in an Excel Spreadsheet
Replies
4
Views
486
Artik
Artik

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

Share this page

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
Back
Top