VBA to automatically adjust my Y-Axis

[yad]

i have a code that adjust the Y-axis of my chart but it applies that to all the chart and i only need it to be applied on chart 8 . help please .
here is the code :

Sub AdjustVerticalAxis()
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


Padding = 0.1


Application.ScreenUpdating = False


For Each cht In ActiveSheet.ChartObjects


FirstTime = True


For Each srs In cht.Chart.SeriesCollection

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


If FirstTime = True Then
MaxChartNumber = MaxNumber
ElseIf MaxNumber > MaxChartNumber Then
MaxChartNumber = MaxNumber
End If


MinNumber = Application.WorksheetFunction.Min(srs.Values)


If FirstTime = True Then
MinChartNumber = MinNumber
ElseIf MinNumber < MinChartNumber Or MinChartNumber = 0 Then
MinChartNumber = MinNumber
End If


FirstTime = False
Next srs


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

Next cht

Application.ScreenUpdating = True

End Sub

 

[rlv01]

One way

Sub AdjustVerticalAxis()
    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
    Dim ChartName As String
    
    ChartName = "Chart 8" 'chart to process
    
    On Error Resume Next
    Set cht = ActiveSheet.ChartObjects(ChartName)
    On Error GoTo 0
    
    If Not cht Is Nothing Then
        Padding = 0.1
        Application.ScreenUpdating = False
        FirstTime = True
        
        For Each srs In cht.Chart.SeriesCollection
            MaxNumber = Application.WorksheetFunction.Max(srs.Values)
            
            If FirstTime = True Then
                MaxChartNumber = MaxNumber
            ElseIf MaxNumber > MaxChartNumber Then
                MaxChartNumber = MaxNumber
            End If
            
            MinNumber = Application.WorksheetFunction.Min(srs.Values)
            
            If FirstTime = True Then
                MinChartNumber = MinNumber
            ElseIf MinNumber < MinChartNumber Or MinChartNumber = 0 Then
                MinChartNumber = MinNumber
            End If
            
            FirstTime = False
        Next srs
        
        cht.Chart.Axes(xlValue).MinimumScale = MinChartNumber * (1 - Padding)
        cht.Chart.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)
        Application.ScreenUpdating = True
    Else
        MsgBox "Cannot find " & ChartName
    End If
End Sub

 

[yad]

Thank you infinitely ! you aced it

 

[yad]

One way

Sub AdjustVerticalAxis()
    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
    Dim ChartName As String
   
    ChartName = "Chart 8" 'chart to process
   
    On Error Resume Next
    Set cht = ActiveSheet.ChartObjects(ChartName)
    On Error GoTo 0
   
    If Not cht Is Nothing Then
        Padding = 0.1
        Application.ScreenUpdating = False
        FirstTime = True
       
        For Each srs In cht.Chart.SeriesCollection
            MaxNumber = Application.WorksheetFunction.Max(srs.Values)
           
            If FirstTime = True Then
                MaxChartNumber = MaxNumber
            ElseIf MaxNumber > MaxChartNumber Then
                MaxChartNumber = MaxNumber
            End If
           
            MinNumber = Application.WorksheetFunction.Min(srs.Values)
           
            If FirstTime = True Then
                MinChartNumber = MinNumber
            ElseIf MinNumber < MinChartNumber Or MinChartNumber = 0 Then
                MinChartNumber = MinNumber
            End If
           
            FirstTime = False
        Next srs
       
        cht.Chart.Axes(xlValue).MinimumScale = MinChartNumber * (1 - Padding)
        cht.Chart.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)
        Application.ScreenUpdating = True
    Else
        MsgBox "Cannot find " & ChartName
    End If
End Sub

Hello again, the code worked great , i'd like to know if there is a way to make it function without having to run the macro everytime ?
Thank you

 

[rlv01]

That's a different problem from applying the code to a different chart. You should start a new thread for the new problem.