Create line chart using one series and then loop using other data sets (copying format from a nominated chart object)

vbanewb1986

New Member
Joined
Nov 4, 2013
Messages
9
Hi everyone,

I need Excel VBA to perform a simple task over and over again. I want to create a line chart using one series (say, Income) that I have given a named range (ChartStartPoint) and a date series that also has a named range associated (ChartDataRange). I will above chart will serve as the blueprint for how the other charts will be formatted.

I have nine more series of data that I want to loop through and create line charts for, while copying the format of the first chart (one of 10). This is my first attempt at a macro using chart objects. I have tried to create charts and and look back through the code; the part I cannot get past is when I want to select the new chart and remove the legend - I am not even sure if the code beyond that works. I have tried to setup a chart object but kept getting error messages as well. Even if I knew how to select a dynamic object, I would have to setup a loop to cycle through each new chart object when I create them (I created the chtcounter variable but the code is giving me problems; any help would be great - thank you).



Sub ReplicateLineChart()
Dim chtcounter As Integer
For chtcounter = 52 To 62
ActiveSheet.range("ChartStartPoint").Select

'Add a chart
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=range("Calculations!$L$12:$W$12")
ActiveChart.ChartType = xlLine
ActiveChart.SeriesCollection(1).XValues = _
"='FILE NAME.xls'!ChartDataRange"


'Delete the legend
ActiveSheet.objectchart.Legend.Select.Delete

'Select the chart and set the Y axis range
ActiveSheet.ChartObjects("Chart & chtcounter").Activate
'Will always refer to the range below
cht.SeriesCollection(1).XValues = "=Calculations!$M$2:$W$2"
ActiveWindow.SmallScroll Down:=6

'Copy the chart formatting from another chart
ActiveSheet.ChartObjects("Chart19").Activate
cht.ChartArea.Copy

'Select the chart you want to apply the formatting to
ActiveSheet.ChartObjects("Chart & chtcounter").Activate
ActiveSheet.PasteSpecial Format:=2
cht.ChartTitle.Select
cht.ChartTitle.Text = "Company Name" & " Staff Costs: Income (YTD)"

'Before the loop starts over I need the series to move down one row
ActiveSheet.range("ChartStartPoint").Offset(1, 0) = ChartStartPoint
Next chtcounter
End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Hi


  • What Excel version are you using? It matters because on some of them the Paste method will copy chart data along with the formats; it just happened to me, see this page:
Apply Chart Formatting to Other Charts - Peltier Tech Blog



  • Anyway, this example shows how to do what you asked for, although it will need some tweaking. If the logic for the range references is off, please explain exactly what are the actual ranges to be used for each chart.
Code:
Sub ReplicateLineChart()
Dim cc%, cob As ChartObject, StartPoint As Range
' tested with Excel 07
Set StartPoint = Sheets("Calculations").Range("m10:w10")


For cc = 1 To 4
    Set cob = ActiveSheet.ChartObjects.Add(Left:=Cells(2, 4 * cc).Left, Width:=Range("b2:m2").Width, _
    Top:=Cells(5 * cc, 2).Top, Height:=Range("b2:b18").Height)
    With cob.Chart
        .SetSourceData StartPoint
        .ChartType = xlLine
        .Legend.Delete
        .SeriesCollection(1).XValues = "=Calculations!$M$2:$W$2"
        ActiveSheet.ChartObjects("Chart19").Activate
        ActiveChart.ChartArea.Copy
        .Paste xlFormats
        .HasTitle = True
        .ChartTitle.Text = "Company Name " & cc & " -Staff Costs: Income (YTD)"
        Set StartPoint = StartPoint.Offset(1)
    End With
Next
End Sub
 
Upvote 0
Hi


  • What Excel version are you using? It matters because on some of them the Paste method will copy chart data along with the formats; it just happened to me, see this page:
Apply Chart Formatting to Other Charts - Peltier Tech Blog



  • Anyway, this example shows how to do what you asked for, although it will need some tweaking. If the logic for the range references is off, please explain exactly what are the actual ranges to be used for each chart.
Code:
Sub ReplicateLineChart()
Dim cc%, cob As ChartObject, StartPoint As Range
' tested with Excel 07
Set StartPoint = Sheets("Calculations").Range("m10:w10")


For cc = 1 To 4
    Set cob = ActiveSheet.ChartObjects.Add(Left:=Cells(2, 4 * cc).Left, Width:=Range("b2:m2").Width, _
    Top:=Cells(5 * cc, 2).Top, Height:=Range("b2:b18").Height)
    With cob.Chart
        .SetSourceData StartPoint
        .ChartType = xlLine
        .Legend.Delete
        .SeriesCollection(1).XValues = "=Calculations!$M$2:$W$2"
        ActiveSheet.ChartObjects("Chart19").Activate
        ActiveChart.ChartArea.Copy
        .Paste xlFormats
        .HasTitle = True
        .ChartTitle.Text = "Company Name " & cc & " -Staff Costs: Income (YTD)"
        Set StartPoint = StartPoint.Offset(1)
    End With
Next
End Sub


Hi Worf,

Thanks for your post. I understand the initial part when you set the range variable, the loop and the offset element to the range variable. However, I am struggling to understand how you have added a chart, made this dynamic and what you've done with the height, width, etc. I know these are chart object properties, but I don't know what to set them as.

To make things easier, say I have January til October in range B2:K2. Cells A2:A10 hold different office names. The values can be anything, but let's assign random figures from 1,000 to 2,000, so I set my initial range variable as the first row for the data source. Using this example, what code would I need to create a graph for the first range, delete the legend and apply axis formatting? I then want to offset the data source range so that the next chart object uses the next row. Can you please explain with the above data how I loop through chart objects and make the data source shift down? When I try to replace the chart number with a variable, say, i Excel doesn't like it. I'm using 2007 version. Thank you for your help.
 
Upvote 0
Hi
Read Excel Help for more information on chartobjects.add method.
Below you can find another example, based on your last post, and the data layout I used. Tell me if you need modifications.

Calculations

*ABCDEFGHIJK
2*janfebmaraprmayjunjulaugsepoct
3Miami1230123511351894154810751183184311111434
4Atlanta1077111816001737128914521854165617831553
5Chicago1203167115361794165013321569141910281655
6Boston1190109314231895149810001101199313591349
7New York1461151215791274115616471073149111741677
8Los Angeles1061105218291066103314471465194913591637
9Denver1989176117861637126114341276106114491809
10Charlotte1114124311671557112116911707170518121841

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:92px;"><col style="width:72px;"><col style="width:72px;"><col style="width:72px;"><col style="width:72px;"><col style="width:72px;"><col style="width:72px;"><col style="width:72px;"><col style="width:72px;"><col style="width:72px;"><col style="width:72px;"></colgroup><tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4
Code:
Sub Replicate2()
Dim cc%, co As ChartObject, sp As Range, sn$
sn = "Calculations"     ' sheet name
Set sp = Sheets(sn).Range("b3:k3")


For cc = 3 To 10
    ' add chart and assign it to co object
    Set co = ActiveSheet.ChartObjects.Add(Left:=Cells(2, 4 * cc).Left, Width:=Range("b2:m2").Width, _
    Top:=Cells(5 * cc, 2).Top, Height:=Range("b2:b18").Height)
    With co.Chart
        .ChartType = xlLineMarkers
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = "=" & sn & "!$b$2:$k$2"
        .SeriesCollection(1).Values = sp
        .Legend.Delete
        .HasTitle = True
        .ChartTitle.Characters.Text = Sheets(sn).Cells(cc, 1).Value
        .Axes(xlValue).MaximumScale = 2100
        .Axes(xlValue).MinimumScale = 900
        .Axes(xlValue).MajorUnit = 100
        Set sp = sp.Offset(1)       ' move one row down
    End With
Next


End Sub
 
Upvote 0
Hi
Read Excel Help for more information on chartobjects.add method.
Below you can find another example, based on your last post, and the data layout I used. Tell me if you need modifications.

Calculations

*ABCDEFGHIJK
2*janfebmaraprmayjunjulaugsepoct
3Miami1230123511351894154810751183184311111434
4Atlanta1077111816001737128914521854165617831553
5Chicago1203167115361794165013321569141910281655
6Boston1190109314231895149810001101199313591349
7New York1461151215791274115616471073149111741677
8Los Angeles1061105218291066103314471465194913591637
9Denver1989176117861637126114341276106114491809
10Charlotte1114124311671557112116911707170518121841

<tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4
Code:
Sub Replicate2()
Dim cc%, co As ChartObject, sp As Range, sn$
sn = "Calculations"     ' sheet name
Set sp = Sheets(sn).Range("b3:k3")


For cc = 3 To 10
    ' add chart and assign it to co object
    Set co = ActiveSheet.ChartObjects.Add(Left:=Cells(2, 4 * cc).Left, Width:=Range("b2:m2").Width, _
    Top:=Cells(5 * cc, 2).Top, Height:=Range("b2:b18").Height)
    With co.Chart
        .ChartType = xlLineMarkers
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = "=" & sn & "!$b$2:$k$2"
        .SeriesCollection(1).Values = sp
        .Legend.Delete
        .HasTitle = True
        .ChartTitle.Characters.Text = Sheets(sn).Cells(cc, 1).Value
        .Axes(xlValue).MaximumScale = 2100
        .Axes(xlValue).MinimumScale = 900
        .Axes(xlValue).MajorUnit = 100
        Set sp = sp.Offset(1)       ' move one row down
    End With
Next


End Sub

Hi Worf,

Brilliant post-spot on with the code!Thank you!I was trying to loop through the chart objects when I should have just looped through the data series range. If I want the graphs, once produced, to be one cell below the previous graphs, rather than overlapping each other, how would I amend the Top:=Cells(5 * cc,2)? Otherwise I have to select the charts and align them. Also, what if the dataset contained two series per graph? I know I could create two variables - sp1 and sp2 - and offset them by 2 for each new chart? Would I still put ISeriesCollection(1).Values = sp1 and ISeriesCollection(2).values = sp2?
 
Upvote 0
Hi
This example doesn't overlap the charts, which have two series each:

Calculations

*ABCDEFGHIJK
2*janfebmaraprmayjunjulaugsepoct
3Miami1087193019931750163314251108163214401000
4*1962115013291732175917851016135312111100
5Atlanta1814100315481190154113281764191818061200
6*1512192915711031171113051788159215201300
7Boston1651113916591712127218871168101419001400
8*1295129717501358179712191317188319381500

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"></colgroup><tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4
Code:
Sub Replicate2()
Dim cc%, co As ChartObject, sp As Range, sn$
sn = "Calculations"     ' sheet name
Set sp = Sheets(sn).Range("b3:k3")


For cc = 1 To 3         ' three charts
    ' add chart and assign it to co object
    Set co = ActiveSheet.ChartObjects.Add(Left:=Cells(2, 14).Left, Width:=Range("b2:m2").Width, _
    Top:=Cells(2 + cc * 17, 2).Top, Height:=Range("b2:b18").Height)
    With co.Chart
        .ChartType = xlLineMarkers
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Values = sp
        .SeriesCollection(1).XValues = "=" & sn & "!$b$2:$k$2"
        .SeriesCollection.NewSeries
        Set sp = sp.Offset(1)
        .SeriesCollection(2).Values = sp
        .SeriesCollection(2).XValues = "=" & sn & "!$b$2:$k$2"
        .Legend.Delete
        .HasTitle = True
        .ChartTitle.Characters.Text = Sheets(sn).Cells(2 * cc + 1, 1).Value
        .Axes(xlValue).MaximumScale = 2100
        .Axes(xlValue).MinimumScale = 900
        .Axes(xlValue).MajorUnit = 100
        Set sp = sp.Offset(1)       ' move one row down
    End With
Next


End Sub
 
Upvote 0
Hi
This example doesn't overlap the charts, which have two series each:

Calculations

*ABCDEFGHIJK
2*janfebmaraprmayjunjulaugsepoct
3Miami1087193019931750163314251108163214401000
4*1962115013291732175917851016135312111100
5Atlanta1814100315481190154113281764191818061200
6*1512192915711031171113051788159215201300
7Boston1651113916591712127218871168101419001400
8*1295129717501358179712191317188319381500

<tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4
Code:
Sub Replicate2()
Dim cc%, co As ChartObject, sp As Range, sn$
sn = "Calculations"     ' sheet name
Set sp = Sheets(sn).Range("b3:k3")


For cc = 1 To 3         ' three charts
    ' add chart and assign it to co object
    Set co = ActiveSheet.ChartObjects.Add(Left:=Cells(2, 14).Left, Width:=Range("b2:m2").Width, _
    Top:=Cells(2 + cc * 17, 2).Top, Height:=Range("b2:b18").Height)
    With co.Chart
        .ChartType = xlLineMarkers
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Values = sp
        .SeriesCollection(1).XValues = "=" & sn & "!$b$2:$k$2"
        .SeriesCollection.NewSeries
        Set sp = sp.Offset(1)
        .SeriesCollection(2).Values = sp
        .SeriesCollection(2).XValues = "=" & sn & "!$b$2:$k$2"
        .Legend.Delete
        .HasTitle = True
        .ChartTitle.Characters.Text = Sheets(sn).Cells(2 * cc + 1, 1).Value
        .Axes(xlValue).MaximumScale = 2100
        .Axes(xlValue).MinimumScale = 900
        .Axes(xlValue).MajorUnit = 100
        Set sp = sp.Offset(1)       ' move one row down
    End With
Next


End Sub

Worf, great coding! That is spot on - thank you.
 
Upvote 0

Forum statistics

Threads
1,215,143
Messages
6,123,275
Members
449,093
Latest member
Vincent Khandagale

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top