Updating a VBA code so it runs for all charts in a worksheet insted of a selected one

[Tshelky]

Hello,

I need to update a range set of hunderds of charts each time I run a macro. I have already found a code on the internet that works as a perfect base for this pourpose. The only problem with it is that it updates the data only for a selected chart insted of all charts in the worksheet. Obviously, I cant do VBA nor any sort of coding whatsoever; could anyone help me out?

Sub ChangeChartRange()
    Dim i As Integer, r As Integer, n As Integer, p1 As Integer, p2 As Integer, p3 As Integer
    Dim rng As Range
    Dim ax As Range

    'Cycles through each series
    For n = 1 To ActiveChart.SeriesCollection.Count Step 1
        r = 0

        'Finds the current range of the series and the axis
        For i = 1 To Len(ActiveChart.SeriesCollection(n).Formula) Step 1
            If Mid(ActiveChart.SeriesCollection(n).Formula, i, 1) = "," Then
                r = r + 1
                If r = 1 Then p1 = i + 1
                If r = 2 Then p2 = i
                If r = 3 Then p3 = i
            End If
        Next i


        'Defines new range
        Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 + 1, p3 - p2 - 1))
        Set rng = Range(rng, rng.Offset(0, 1))

        'Sets new range for each series
        ActiveChart.SeriesCollection(n).Values = rng

        'Updates axis
        Set ax = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p1, p2 - p1))
        Set ax = Range(ax, ax.Offset(0, 1))
        ActiveChart.SeriesCollection(n).XValues = ax

    Next n
End Sub

 

[Domenic]

You can iterate through each chart within the active sheet as follows...

    Dim chrt_obj As ChartObject
    Dim curr_chrt As Chart

    For Each chrt_obj In ActiveSheet.ChartObjects
    
        Set curr_chrt = chrt_obj.Chart
        
        'etc
        '
        '
        
    Next chrt_obj

So your code can be amended as follows...

Sub ChangeChartRange()
    Dim i As Integer, r As Integer, n As Integer, p1 As Integer, p2 As Integer, p3 As Integer
    Dim rng As Range
    Dim ax As Range
    Dim chrt_obj As ChartObject
    Dim curr_chrt As Chart

    For Each chrt_obj In ActiveSheet.ChartObjects
    
        Set curr_chrt = chrt_obj.Chart
        
        'Cycles through each series
        For n = 1 To curr_chrt.SeriesCollection.Count Step 1
            r = 0
    
            'Finds the current range of the series and the axis
            For i = 1 To Len(curr_chrt.SeriesCollection(n).Formula) Step 1
                If Mid(curr_chrt.SeriesCollection(n).Formula, i, 1) = "," Then
                    r = r + 1
                    If r = 1 Then p1 = i + 1
                    If r = 2 Then p2 = i
                    If r = 3 Then p3 = i
                End If
            Next i
    
    
            'Defines new range
            Set rng = Range(Mid(curr_chrt.SeriesCollection(n).Formula, p2 + 1, p3 - p2 - 1))
            Set rng = Range(rng, rng.Offset(0, 1))
    
            'Sets new range for each series
            curr_chrt.SeriesCollection(n).Values = rng
    
            'Updates axis
            Set ax = Range(Mid(curr_chrt.SeriesCollection(n).Formula, p1, p2 - p1))
            Set ax = Range(ax, ax.Offset(0, 1))
            curr_chrt.SeriesCollection(n).XValues = ax
    
        Next n
    Next chrt_obj
End Sub

Hope this helps!

 

[Tshelky]

You can iterate through each chart within the active sheet as follows...

    Dim chrt_obj As ChartObject
    Dim curr_chrt As Chart

    For Each chrt_obj In ActiveSheet.ChartObjects
   
        Set curr_chrt = chrt_obj.Chart
       
        'etc
        '
        '
       
    Next chrt_obj

So your code can be amended as follows...

Sub ChangeChartRange()
    Dim i As Integer, r As Integer, n As Integer, p1 As Integer, p2 As Integer, p3 As Integer
    Dim rng As Range
    Dim ax As Range
    Dim chrt_obj As ChartObject
    Dim curr_chrt As Chart

    For Each chrt_obj In ActiveSheet.ChartObjects
   
        Set curr_chrt = chrt_obj.Chart
       
        'Cycles through each series
        For n = 1 To curr_chrt.SeriesCollection.Count Step 1
            r = 0
   
            'Finds the current range of the series and the axis
            For i = 1 To Len(curr_chrt.SeriesCollection(n).Formula) Step 1
                If Mid(curr_chrt.SeriesCollection(n).Formula, i, 1) = "," Then
                    r = r + 1
                    If r = 1 Then p1 = i + 1
                    If r = 2 Then p2 = i
                    If r = 3 Then p3 = i
                End If
            Next i
   
   
            'Defines new range
            Set rng = Range(Mid(curr_chrt.SeriesCollection(n).Formula, p2 + 1, p3 - p2 - 1))
            Set rng = Range(rng, rng.Offset(0, 1))
   
            'Sets new range for each series
            curr_chrt.SeriesCollection(n).Values = rng
   
            'Updates axis
            Set ax = Range(Mid(curr_chrt.SeriesCollection(n).Formula, p1, p2 - p1))
            Set ax = Range(ax, ax.Offset(0, 1))
            curr_chrt.SeriesCollection(n).XValues = ax
   
        Next n
    Next chrt_obj
End Sub

Hope this helps!

Thanks a lot, it works! Really aprreciate it!

 

[Domenic]

That's great, I'm glad I could help, cheers!

 

[Tham_Nguyen]

Thanks a lot, it works! Really aprreciate it!

Hello,
I am a very new user to this platform. I've read your solution with great interest, because I have nearly the same problem as you have. Gratulations that you managed to solve it. My problem is, that every morning I have to update 14 charts. The data range for the charts is always increased by one line after each day has elapsed. The data source for the charts I stored in several sheets to increase clarity. All the charts I stored in one sheet. I would very much like to use your code. But because I am a novice with regard to programming in visual basic, there are some lines I do not quite understand. Would it be possible that we set up a zoom-meeting so that I can ask you some questions? Is it o.k. that I also use your code to facilitate my task? I really appreciate it a lot if we can talk to each other for mutual help.

If it is o.k. for you , so the next step is to exchange the e-mail adresses to set up a zoom- or a teams-meeting, as you wish.

I am looking forward to hearing from you.

Best regards