9

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?

4 Answers 4

7

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.
Sign up to request clarification or add additional context in comments.

2 Comments

I agree this is better for a single data series, but you cannot use this in the "chart data range" for several series. Since I have about a hundred series, I would rather not do this.
This is a very useful solution. If someone needs to do this with VBA at run-time, check @JonPeltier 's answer here . Works like a charm.
5

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

8 Comments

If you're going to declare variables (which you should) you should declare them as proper types: Dim i as Integer, r as Integer, n as Integer, p1 as Integer, p2 as Integer. Your declaration creates i, r, n, p1 as Variant :)
@DavidZemens I actually wasn't aware of that. Thanks!
rng is assigned twice and I don't think t is assigned. Is that a typo?
And FullSeriesCollection is giving an error. And do you know how to adjust the x-axis range?
@Stuart You are right. That was a typo. See if the code works now. It works for me using Excel 2013.
|
4

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

3 Comments

The printout seems to be working (using MsgBox), but the chart isn't updating.
@Stuart Code updated to work on first chart in the Activesheet, please post outputs from Immediate window if it doesn't work.
For some reason @Søren method Mid functions did not work for me. @PatricK option using Split saved me.
1

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

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.