Seeker After
Member
I am a total newbie to VBA trying to jump in. The code below (that someone who has way more experience put together) functionally does what I need but there are a couple of changes that would make it safer to run for my purposes. How does the code change to limit it to run only in a particular sheet, Line, and only on the change of value (text) in a specified cell on that sheet, J11? I have been reading and testing others responses to this elsewhere and can't get it to work. Learned a lot but not feeling any closer to a solution after a lot of time spent. Any help would be huge.
Code:
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