Macro that Adjust All chart ranges with Data Validation

daesha2010

New Member
Joined
Feb 16, 2017
Messages
2
Hello,

I need help writing a macro that adjust my axis min and max bounds automatically with data validation.

I have the macro below currently but it only makes adjustments to the current selection. How can I get the macro to automatically run every time I change the drop down choices.


Sub AdjustVerticalAxis()
'PURPOSE: Adjust Y-Axis according to Min/Max of Chart Data


Dim cht As ChartObject
Dim srs As Series
Dim FirstTime As Boolean
Dim MaxNumber As Double
Dim MinNumber As Double
Dim MaxChartNumber As Double
Dim MinChartNumber 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 = 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)

'Store value if currently the overall Maximum Value
If FirstTime = True Then
MaxChartNumber = MaxNumber
ElseIf MaxNumber > MaxChartNumber Then
MaxChartNumber = 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 = True Then
MinChartNumber = MinNumber
ElseIf MinNumber < MinChartNumber Or MinChartNumber = 0 Then
MinChartNumber = MinNumber
End If

'First Time Looking at This Chart?
FirstTime = False
Next srs

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

Next cht


'Optimize Code
Application.ScreenUpdating = True


End Sub
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
I figured it out.

1) Click on the Developer tab.
2) Click on the Visual Basic icon.
3) On the left pane window, double click the sheet where you need your code to run.
4) Now, at the top of the code window you will see... (General) with a drop down, and (Declarations) with a drop down.
5) Click the drop down by (General) and select Worksheet.
6) Now in the code window you will see.... Private Sub Worksheet_SelectionChange(ByVal Target As Range)
7) Remove the word "Selection". You want to remove "Selection" because that means when you click on a cell in the worksheet something will happen. You do not want that, you want to enter a value in D10. It should now read...Private Sub Worksheet_Change(ByVal Target As Range)
8) Now this is where you want the code...

Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Address = "$D$10" Then

Call MyMacro

End If

End Sub
 
Upvote 0

Forum statistics

Threads
1,214,642
Messages
6,120,700
Members
448,979
Latest member
DET4492

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