Forum Discussion
JJ Eggers
Oct 19, 2017Copper Contributor
I am trying to make a separate charts for each row on the same sheet.
I am having an issue with making the charts uniform. Row 1 is the Titles for the columns Row 2 - 5 is what I am looking to make separate charts for. Well this works well with Row 2, but whe...
JonPeltier
May 04, 2021MVP
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:
Owen_Boyle
May 04, 2021Copper Contributor
That looks great! It's exactly what I'm trying to do; the columns (A,B,C,D,E) are the stages in a process. The numbers in the cells are the amount of product at each stage in the process. The rows are different times. So each graph is a snapshot of the production line. I want to see how it progresses over time, so I had a movie where each graph is a frame. The more frames, the more fine-grained the visualisation, so I need an automatic process to turn the data from the process monitor into individual frames. This looks like it could that!
I'll try it and get back to you...
I'll try it and get back to you...