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?
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
Offset function dynamic range makes it possible.
- Define a dynamic named range
=OFFSET(Sheet1!$A$2,,,1,COUNTA(Sheet1!$A$2:$Z$2))and give it a
- Right Click on Chart
- Click on Select Data
This screen will come
Edit under Legend Entries.(mobiles is selected)
- change the Series value to point to
- Now if data for future months are added to mobile sales it will automatically reflect in chart.
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
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
After first run: