Copy paste charts with dynamic rows/column references

[mischifous]

Hey guys,

Not sure if I neeed VBA to accomplish this or not, but I can’t be the first that needs a way to do this.

I have a column of dates in A. In column B I am computing the AVERAGE of the values in columns C through Z). And then in columns C through Z I have data.

I would like an easy way to diluplicate a chart, but have it automatically reference a column to the right of the chart it is a copy of. Each chart has TWO lines. In other words, say chart one plots the column (B) and Column C, over time (column A). I would like to be able to make changes to this chart, and then easily replicate it for the 23 OTHER charts I have for each column D to Z. Each chart needs to be unique, so in this example, 24 charts (c through Z), but all need to include the data in A and B.

The data I’m working with is actually much more complicated than the example (and larger than just C to Z), and also has multiple axes with several different data sets that need to be in each graph. I spend hours each day adjusting each and every chart manually to reference the correct data sets. I’m also constantly changing the formatting, which then requires me to then copy/paste and re-reference EVERY chart. Being able to copy/paste charts over dynamic ranges would greatly speed up this time consuming process. I even bought a Tableau subscription to accomplish specifically this purpose, but for seperate reasons, it won’t work for visualizing my data.

All help appreciated.

 

[Worf]

An example:

Sub Mischifous()
Dim co As ChartObject, r As Range, a, i%, s As Series
Set r = [c1]
Set co = ActiveSheet.ChartObjects("chart 1")            ' base chart
For i = 1 To 5                                          ' five charts
    co.Chart.ChartArea.Copy
    ActiveSheet.Paste
    a = Split(r.Address, "$")                           ' get column letter
    Set s = ActiveChart.SeriesCollection(2)             ' series to update
    s.Values = "=Targ!$" & a(1) & "$71:$" & a(1) & "$80"
    s.XValues = "=Targ!$a$71:$a$80"                     ' dates
    s.Name = Cells(70, r.Column)
    Set r = r.Offset(, 1)                               ' one column to the right
    Cells(1 + 10 * i, 1 + 10 * i).Activate              ' cascade charts
Next
End Sub

 

[mischifous]

An example:

Sub Mischifous()
Dim co As ChartObject, r As Range, a, i%, s As Series
Set r = [c1]
Set co = ActiveSheet.ChartObjects("chart 1")            ' base chart
For i = 1 To 5                                          ' five charts
    co.Chart.ChartArea.Copy
    ActiveSheet.Paste
    a = Split(r.Address, "$")                           ' get column letter
    Set s = ActiveChart.SeriesCollection(2)             ' series to update
    s.Values = "=Targ!$" & a(1) & "$71:$" & a(1) & "$80"
    s.XValues = "=Targ!$a$71:$a$80"                     ' dates
    s.Name = Cells(70, r.Column)
    Set r = r.Offset(, 1)                               ' one column to the right
    Cells(1 + 10 * i, 1 + 10 * i).Activate              ' cascade charts
Next
End Sub

Hey man thanks for the response.

Trying to understand what I'm looking at here. Everything within Quotes I need to fill specific to my data, right?

 

[Worf]

Yes, you have to adapt it. I am posting a new version along with the test range; tell me if you can understand it.

Excel Workbook
	A	B	C	D	E	F	G
70	Dates	col B	col C	col D	col E	col F	col G
71	07/08/1995	4	7	6	10	2	5
72	08/10/1995	7	12	9	13	8	8
73	09/12/1995	10	17	12	16	14	1
74	09/02/1996	13	22	15	19	20	14
75	11/04/1996	16	27	18	22	26	17
76	12/06/1996	19	32	21	25	32	20
77	13/08/1996	22	37	25	28	38	23
78	14/10/1996	25	42	27	31	44	26
79	15/12/1996	28	47	30	34	50	29
80	15/02/1997	31	52	33	37	56	32
sheet1

Sub Mischifous()
Dim cob As ChartObject, r As Range, a, i%, s As Series, c As ChartObject
Set r = [c1]
Set cob = ActiveSheet.ChartObjects("chart 1")            ' base chart
For i = 1 To 5                                          ' five charts
    cob.Chart.ChartArea.Copy
    ActiveSheet.Paste
    Set c = ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count)
    a = Split(r.Address, "$")                            ' get column letter
    Set s = c.Chart.SeriesCollection(1)                  ' series to update
    c.Chart.Parent.Name = "chart" & i
    c.Top = 1 + 120 * i
    c.Left = 1 + 90 * i
    s.Values = "=sheet1!$" & a(1) & "$71:$" & a(1) & "$80"      ' Y values
    s.XValues = "=sheet1!$a$71:$a$80"                           ' dates
    s.Name = Cells(70, r.Column)
    Set r = r.Offset(, 1)                               ' one column to the right
Next
End Sub