CODEWITHSUNDEEP
excelvbachartsrange
Stuart
Stuart

Reputation: 1773

VBA: Modify chart data range

My "Chart data range" is ='sheet1'!$A$1:$Z$10. I'd like to make a VBA macro (or if anybody knows a formula I can use, but I couldn't figure one out) to increase the ending column of the range for chart1 by 1 every time I run the macro. So essentially:

chart1.endCol = chart1.endCol + 1

What is the syntax for this using ActiveChart or is there a better way?

Upvotes: 9

Views: 107904

Answers (5)

bw757
bw757

Reputation: 1

PatricK and sirbedevire got me started with this fairly well. Now, I'm trying to consolidate it into a separate sub I can reference to process multiple charts. Unfortunately, I'm missing something in the referencing so it's not making the updates (and not producing an error).

1st sub using 2nd sub

If ws < numTabs - 1 Then
    chartUpdate Summary, Chart_BidsByMonth ' Name of sheet with target chart, Name of target chart
    chartUpdate Summary, Chart_SoldByMonth ' Name of sheet with target chart, Name of target chart
End If

2nd sub processing chart range update

Sub chartUpdate(shtRef As Variant, chtRef As Variant)
    On Error Resume Next
    Dim oCht As Chart, aFormulaOld As Variant, aFormulaNew As Variant
    Dim n As Long, s As Long
    Dim oRng As Range, sTmp As String, sBase As String

        ' Update chart referenced as chtRef '
        Set oCht = Sheets(""" & shtRef & """).ChartObjects(""" & chtRef """).Chart
        oCht.Select
        For s = 1 To oCht.SeriesCollection.Count
            sTmp = oCht.SeriesCollection(s).Formula
            sBase = Split(sTmp, "(")(0) & "(<FORMULA>)" ' "=SERIES(" & "<FORMULA>)"
            sTmp = Split(sTmp, "(")(1) ' "..., ..., ...)"
            aFormulaOld = Split(Left(sTmp, Len(sTmp) - 1), ",") ' "..., ..., ..."
            aFormulaNew = Array()
            ReDim aFormulaNew(UBound(aFormulaOld))
            ' Process all series in the formula
            For n = 0 To UBound(aFormulaOld)
                Set oRng = Range(aFormulaOld(n))
                ' Attempt to put the value into Range, keep the same if it's not valid Range
                If Err.Number = 0 Then
                    Set oRng = oRng.Worksheet.Range(oRng, oRng.Offset(0, 1))
                    aFormulaNew(n) = "'" & oRng.Worksheet.Name & "'" & "!" & oRng.Address
                Else
                    aFormulaNew(n) = aFormulaOld(i)
                    Err.Clear
                End If
            Next n
            sTmp = Replace(sBase, "<FORMULA>", Join(aFormulaNew, ","))
            Debug.Print "Series(" & s & ") from """ & oCht.SeriesCollection(s).Formula & """ to """ & sTmp & """"
            oCht.SeriesCollection(s).Formula = sTmp
            sTmp = ""
        Next s
        Set oCht = Nothing
        ' End charts update '
    End Sub

Upvotes: 0

PatricK
PatricK

Reputation: 6433

Assuming that you only run the macro with a Chart Selected, my idea is to alter the range in the formula for each Series. You can of cause change to apply to all Charts in a Worksheet.

UPDATE: Have changed code to accommodate multiple series with screenshots

Formatting of new series string needs to include apostrophes around the worksheet name (already changed below): aFormulaNew(i) = "'" & oRng.Worksheet.Name & "'" & "!" & oRng.Address. Also, if looking to change rows rather than columns, change the offset to Set oRng = oRng.Worksheet.Range(oRng, oRng.Offset(1, 0)) or as needed. Can also include oRng.Offset(1, 0) for the first element in the range to adjust the start position of the series: Set oRng = oRng.Worksheet.Range(oRng.Offset(1, 0), oRng.Offset(1, 0))

Sub ChartRangeAdd()
    On Error Resume Next
    Dim oCht As Chart, aFormulaOld As Variant, aFormulaNew As Variant
    Dim i As Long, s As Long
    Dim oRng As Range, sTmp As String, sBase As String
    
    Set oCht = ActiveSheet.ChartObjects(1).Chart
    oCht.Select
    For s = 1 To oCht.SeriesCollection.count
        sTmp = oCht.SeriesCollection(s).Formula
        sBase = Split(sTmp, "(")(0) & "(<FORMULA>)" ' "=SERIES(" & "<FORMULA>)"
        sTmp = Split(sTmp, "(")(1) ' "..., ..., ...)"
        aFormulaOld = Split(Left(sTmp, Len(sTmp) - 1), ",") ' "..., ..., ..."
        aFormulaNew = Array()
        ReDim aFormulaNew(UBound(aFormulaOld))
        ' Process all series in the formula
        For i = 0 To UBound(aFormulaOld)
            Set oRng = Range(aFormulaOld(i))
            ' Attempt to put the value into Range, keep the same if it's not valid Range
            If Err.Number = 0 Then
                Set oRng = oRng.Worksheet.Range(oRng, oRng.Offset(0, 1))
                aFormulaNew(i) = "'" & oRng.Worksheet.Name & "'" & "!" & oRng.Address
            Else
                aFormulaNew(i) = aFormulaOld(i)
                Err.Clear
            End If
        Next i
        sTmp = Replace(sBase, "<FORMULA>", Join(aFormulaNew, ","))
        Debug.Print "Series(" & s & ") from """ & oCht.SeriesCollection(s).Formula & """ to """ & sTmp & """"
        oCht.SeriesCollection(s).Formula = sTmp
        sTmp = ""
    Next s
    Set oCht = Nothing
End Sub

Sample data - Initial

InitialData

After first run:

FirstRun

Second Run:

SecondRun

Third Run:

ThirdRun

Upvotes: 4

sirbedevire
sirbedevire

Reputation: 13

PatricK's answer works great with some minor adjustments:

Formatting of new series string needs to include apostrophes around the worksheet name on line 22 aFormulaNew(i) = "'" & oRng.Worksheet.Name & "'" & "!" & oRng.Address. Also, if looking to change rows rather than columns, change the offset on line 21 to Set oRng = oRng.Worksheet.Range(oRng, oRng.Offset(1, 0)) or as needed. Can also include oRng.Offset(1, 0) for the first element in the range to adjust the start position of the series: Set oRng = oRng.Worksheet.Range(oRng.Offset(1, 0), oRng.Offset(1, 0))

Sub ChartRangeAdd()
    On Error Resume Next
    Dim oCht As Chart, aFormulaOld As Variant, aFormulaNew As Variant
    Dim i As Long, s As Long
    Dim oRng As Range, sTmp As String, sBase As String

    Set oCht = ActiveSheet.ChartObjects(1).Chart
    oCht.Select
    For s = 1 To oCht.SeriesCollection.count
        sTmp = oCht.SeriesCollection(s).Formula
        sBase = Split(sTmp, "(")(0) & "(<FORMULA>)" ' "=SERIES(" & "<FORMULA>)"
        sTmp = Split(sTmp, "(")(1) ' "..., ..., ...)"
        aFormulaOld = Split(Left(sTmp, Len(sTmp) - 1), ",") ' "..., ..., ..."
        aFormulaNew = Array()
        ReDim aFormulaNew(UBound(aFormulaOld))
        ' Process all series in the formula
        For i = 0 To UBound(aFormulaOld)
            Set oRng = Range(aFormulaOld(i))
            ' Attempt to put the value into Range, keep the same if it's not valid Range
            If Err.Number = 0 Then
                Set oRng = oRng.Worksheet.Range(oRng, oRng.Offset(0, 1))
                aFormulaNew(i) = "'" & oRng.Worksheet.Name & "'" & "!" & oRng.Address
            Else
                aFormulaNew(i) = aFormulaOld(i)
                Err.Clear
            End If
        Next i
        sTmp = Replace(sBase, "<FORMULA>", Join(aFormulaNew, ","))
        Debug.Print "Series(" & s & ") from """ & oCht.SeriesCollection(s).Formula & """ to """ & sTmp & """"
        oCht.SeriesCollection(s).Formula = sTmp
        sTmp = ""
    Next s
    Set oCht = Nothing
End Sub

Upvotes: 1

Netloh
Netloh

Reputation: 4378

Assuming that you want to expand the range (by adding one extra column) to add one more observation for each series in you diagram (and not to add a new series), you could use this code:

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

Upvotes: 5

Santosh
Santosh

Reputation: 12353

Offset function dynamic range makes it possible.

Sample data

enter image description here

Steps

  • Define a dynamic named range =OFFSET(Sheet1!$A$2,,,1,COUNTA(Sheet1!$A$2:$Z$2)) and give it a name mobileRange
  • Right Click on Chart
  • Click on Select Data

This screen will come

enter image description here

Click on Edit under Legend Entries.(mobiles is selected)

enter image description here

  • change the Series value to point to mobileRange named range.
  • Now if data for future months are added to mobile sales it will automatically reflect in chart.

Upvotes: 7

Related Questions