Forum Discussion
I am trying to make a separate charts for each row on the same sheet.
I wrote a little VBA routine to take a chart that uses Y values in one row, and make a copy of the chart, use the next row for the Y values (and name if it uses a cell for the name), and repeat until the next row has no numeric values. Here's how it looks at the start:
Here is the code:
Sub DuplicateActiveChartOncePerRow()
If ActiveChart Is Nothing Then
MsgBox "Select a chart and try again!", vbExclamation + vbOKOnly
GoTo ExitSub
End If
Dim nCharts As Long
nCharts = ActiveSheet.ChartObjects.Count
Dim OriginalChart As Chart
Set OriginalChart = ActiveChart
' SERIES formula
Dim sFormula As String
sFormula = OriginalChart.SeriesCollection(1).Formula
' formula arguments only
sFormula = Mid$(Left$(sFormula, Len(sFormula) - 1), InStr(sFormula, "(") + 1)
' array of arguments
Dim vFormula As Variant
vFormula = Split(sFormula, ",")
' series name - first argument
Dim sName As String
sName = vFormula(LBound(vFormula))
Dim rName As Range
On Error Resume Next
Set rName = Range(sName)
On Error GoTo 0
Dim bNameIsRange As Boolean
bNameIsRange = Not rName Is Nothing
' y values - third argument
Dim sYVals As String
sYVals = vFormula(LBound(vFormula) + 2)
Dim rYVals As Range
On Error Resume Next
Set rYVals = Range(sYVals)
On Error GoTo 0
If rYVals Is Nothing Then
MsgBox "Y Values Are Not in a Range!", vbExclamation + vbOKOnly
GoTo ExitSub
End If
Dim iChart As Long
iChart = 1
Do
' loop until we run out of Y values
If WorksheetFunction.Count(rYVals.Offset(iChart)) = 0 Then
MsgBox "Finished!", vbExclamation + vbOKOnly
GoTo ExitSub
End If
' make copy of original chart
OriginalChart.Parent.Copy
Do
' loop to avoid error because sometimes clipboard isn't ready to paste
DoEvents
On Error Resume Next
ActiveSheet.Paste
On Error GoTo 0
If ActiveSheet.ChartObjects.Count >= nCharts + iChart Then Exit Do
Loop
Dim NewChart As Chart
Set NewChart = ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Chart
NewChart.Parent.Left = OriginalChart.Parent.Left
NewChart.Parent.Top = OriginalChart.Parent.Top + iChart * rYVals.Height
' change Y values and name in new chart
With NewChart.SeriesCollection(1)
.Values = rYVals.Offset(iChart)
If bNameIsRange Then
.Name = "=" & rName.Offset(iChart).Address(, , , True)
End If
End With
iChart = iChart + 1
Loop
ExitSub:
End Sub
And here is the end result:
I have been looking for something like this forever, except my scenario is with XY plots and I want to plot in groups of n. For example, my time is in column B and my data goes through column CT. I want to have 3 consecutive columns per graph. Can something similar be done for this or is that too complicated for excel?
Thanks!
- AFK so I can't give you code now. It sounds like you want column B as X values for all charts, then columns C-E for Y values for the first chart, F-H for the second, etc. It's not really any more complicated than the earlier example.
- JonPeltier
Exactly right. But unfortunately beyond my limited macro skills. Glad to know it is doable. You would sure be my hero if you could help me out. Thanks again!Here is the setup, with the data and the first chart. The first chart is selected so you can see the source data highlighted. I've hidden columns L:CQ so you can see the data extends to CT.
Here is the result. I've selected the second chart so you can see that the highlighted source data has moved to the right.
Here is the code. It does not assume a preset number of rows or columns. It uses the first series of the first chart to define the number of points, it uses the same X values as in the first chart for all charts. It uses as much data as it finds in the contiguous range that includes the first chart's data (so if it stops before or extends beyond CT, it still works). It does not assume three series but uses as many series as are in the first chart. it also does a trick with ActiveWorkbook.ChartDataPointTrack so that custom formatting isn't lost when you change the source data.
Sub DuplicateChart() If ActiveChart Is Nothing Then MsgBox "Select a chart and try again!", vbExclamation, "No Active Chart" GoTo ExitSub End If Dim cht As Chart Set cht = ActiveChart With cht Dim nSrs As Long nSrs = .SeriesCollection.Count Dim sFmla As String sFmla = .SeriesCollection(1).Formula Dim sArgs As String sArgs = Mid$(Left$(sFmla, Len(sFmla) - 1), InStr(sFmla, "(") + 1) Dim vArgs As Variant vArgs = Split(sArgs, ",") Dim sName As String, rName As Range sName = vArgs(LBound(vArgs)) On Error Resume Next Set rName = Range(sName) On Error GoTo 0 If Not rName Is Nothing Then Dim bNameIsRange As Boolean bNameIsRange = True End If Dim sYValues As String, rYValues As Range sYValues = vArgs(LBound(vArgs) + 2) Set rYValues = Range(sYValues) Dim dWidth As Double, dLeft As Double, dTop As Double dWidth = .Parent.Width dLeft = .Parent.Left dTop = .Parent.Top Dim nCharts As Long nCharts = (rYValues.CurrentRegion.Columns.Count - 1) / 3 End With ' do this or custom formatting of chart series will be lost Dim bChartDataPointTrack bChartDataPointTrack = ActiveWorkbook.ChartDataPointTrack ActiveWorkbook.ChartDataPointTrack = False Dim iChart As Long For iChart = 2 To nCharts Set cht = cht.Parent.Duplicate.Chart With cht With .Parent .Left = dLeft + (iChart - 1) * dWidth .Top = dTop End With .ChartTitle.Text = "Chart " & iChart Dim iSrs As Long For iSrs = 1 To nSrs Dim rNewYValues As Range Set rNewYValues = rYValues.Offset(, (iChart - 1) * 3 + iSrs - 1) .SeriesCollection(iSrs).Values = rNewYValues If bNameIsRange Then Dim rNewName As Range Set rNewName = rName.Offset(, (iChart - 1) * 3 + iSrs - 1) .SeriesCollection(iSrs).Name = "=" & rNewName.Address(, , , True) End If Next End With Next ActiveWorkbook.ChartDataPointTrack = bChartDataPointTrack ExitSub: End Sub