Loop to create charts automatically

G

GeeWhiz7

Board Regular
Joined
Nov 22, 2021
Messages
214
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hi folks,
I am not very versant with chart objects and keep getting stuck with the following problem. Thanks for your help!

I have put a simple version of a minisheet below with data. I could not figure out how to capture the charts in the minisheet so an image of the "desired result" is also uploaded.

What I am trying to do.
  • I want to automatically create scatter charts for every second row of data where the the X data is always the A1 (Date) column, but the Y data is every nth+2 column (Tons).
  • Add chart title that equals the header value for that column
  • Put the chart below the previous chart offset by some increment to the top so they are evenly spaced
  • Make the chart object name equal also to the header name so that by the end of the loop each chart object has its own name so I can reference them elsewhere.
I tried to loop a macro recording by copying a "template" chart then assigning the source data, but can't quite get things to work as I have not had any experience with chart objects and the syntax.

What I was thinking...but does not work
VBA Code: 
Sub ChartMaker()

Dim rng As Range
Dim rowNum As Long
Dim topInc As Long


Sheets("Charts").Activate

rowNum = 2
topInc = 300 

For Each rng In Range("B2:I2").Columns
    
    Dim chartObj As ChartObject
    Dim refChart As Chart
      
    Set chartObj = ActiveSheet.ChartObjects.Add(Top:=10 + topInc, Left:=325, Width:=600, Height:=300) 'place the next chart incrementally below the previous chart until all charts are made..
    Set refChart = chartObj.Chart
    refChart.ChartType = xlXYScatter
    refChart.SetSourceData Source:=Range(Cells(2, rowNum), Cells(30, 2)) 'Getting lost here, I dont quite know how to set X (date) and Y data separately
    
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
        ActiveChart.ChartTitle.Text = Cell(2, rowNum) 'Trying to add chart title equal to the header like A Tons or B Tons
    
    With Chart
        .Parent.Name = rowNum 'would like chart object name to be equal to the header like A_Tons or B_Tons, etc

    End If
    
rowNum = rowNum + 2 'idea is to make a chart for every second row.

Next rng

End Sub

Book2.xlsx
ABCDEFGHI
1DateA TonsA OverB TonsB OverC TonsC OverD TonsD Over
26/3/2022131594727153826
36/2/20221311421534230
46/1/2022423017529172614
55/31/20226351332141296755
65/30/2022503852402311131
75/29/20224129463438267462
85/28/2022806814270586755
95/27/202215313150382614
105/26/2022352314258462715
115/25/2022493715349375341
125/24/20222081531866957
135/23/2022153473574623119
145/22/20222917362461494331
155/21/20222917776575633523
165/20/20224937695748364533
175/19/202266547058131164
185/18/20227058402829172412
195/17/20226553786665535240
205/16/2022153251338268068
215/15/202221931192084230
225/14/20223624604847356957
235/13/2022443216456442513
245/12/2022726016427154836
255/11/20223321746237253523
265/10/2022524018668567765
275/9/20225947746237255846
285/8/20223624635148364735
295/7/202236245947131219
305/6/20223523332178665947
Sheet1
 

Attachments

  • ChartsLoop.PNG
    ChartsLoop.PNG
    133.9 KB · Views: 35

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
I hope you mean every second COLUMN of data. Anyway, the following will do what you want. Adjust the constants at the top of the procedure to manipulate the chart positions.

VBA Code: 
Sub ChartMaker()
  Const ChartLeft As Double = 325
  Const ChartTop As Double = 10
  Const ChartWidth As Double = 600
  Const ChartHeight As Double = 300
  Const ChartGap As Double = 25
  
  Worksheets("Charts").Activate
  
  Dim DataRange As Range
  Set DataRange = ActiveSheet.UsedRange
  
  Dim XRange As Range
  With DataRange
    Set XRange = .Offset(1).Resize(.Rows.Count - 1, 1)
  End With

  Dim nCharts As Long
  nCharts = (DataRange.Columns.Count - 1) / 2
  
  Dim iChart As Long
  For iChart = 1 To nCharts
    Dim YRange As Range
    Set YRange = XRange.Offset(, 2 * iChart - 1)
    Dim SeriesName As Range
    Set SeriesName = YRange.Offset(-1).Resize(1)
    
    Dim ThisChart As Chart
    Set ThisChart = ActiveSheet.Shapes.AddChart2(, xlXYScatterLines, ChartLeft, _
      ChartTop + (ChartHeight + ChartGap) * (iChart - 1), ChartWidth, ChartHeight).Chart
    
    ThisChart.SetSourceData Union(XRange, YRange)
    ThisChart.SeriesCollection(1).Name = "=" & SeriesName.Address(, , , True)
    ThisChart.Parent.Name = SeriesName.Value2
  Next

End Sub
 
Upvote 0
Solution
GeeWhiz7 said:
Hi folks,
I am not very versant with chart objects and keep getting stuck with the following problem. Thanks for your help!

I have put a simple version of a minisheet below with data. I could not figure out how to capture the charts in the minisheet so an image of the "desired result" is also uploaded.

What I am trying to do.
  • I want to automatically create scatter charts for every second row of data where the the X data is always the A1 (Date) column, but the Y data is every nth+2 column (Tons).
  • Add chart title that equals the header value for that column
  • Put the chart below the previous chart offset by some increment to the top so they are evenly spaced
  • Make the chart object name equal also to the header name so that by the end of the loop each chart object has its own name so I can reference them elsewhere.
I tried to loop a macro recording by copying a "template" chart then assigning the source data, but can't quite get things to work as I have not had any experience with chart objects and the syntax.

What I was thinking...but does not work
VBA Code: 
Sub ChartMaker()

Dim rng As Range
Dim rowNum As Long
Dim topInc As Long


Sheets("Charts").Activate

rowNum = 2
topInc = 300

For Each rng In Range("B2:I2").Columns
  
    Dim chartObj As ChartObject
    Dim refChart As Chart
    
    Set chartObj = ActiveSheet.ChartObjects.Add(Top:=10 + topInc, Left:=325, Width:=600, Height:=300) 'place the next chart incrementally below the previous chart until all charts are made..
    Set refChart = chartObj.Chart
    refChart.ChartType = xlXYScatter
    refChart.SetSourceData Source:=Range(Cells(2, rowNum), Cells(30, 2)) 'Getting lost here, I dont quite know how to set X (date) and Y data separately
  
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
        ActiveChart.ChartTitle.Text = Cell(2, rowNum) 'Trying to add chart title equal to the header like A Tons or B Tons
  
    With Chart
        .Parent.Name = rowNum 'would like chart object name to be equal to the header like A_Tons or B_Tons, etc

    End If
  
rowNum = rowNum + 2 'idea is to make a chart for every second row.

Next rng

End Sub

Book2.xlsx
ABCDEFGHI
1DateA TonsA OverB TonsB OverC TonsC OverD TonsD Over
26/3/2022131594727153826
36/2/20221311421534230
46/1/2022423017529172614
55/31/20226351332141296755
65/30/2022503852402311131
75/29/20224129463438267462
85/28/2022806814270586755
95/27/202215313150382614
105/26/2022352314258462715
115/25/2022493715349375341
125/24/20222081531866957
135/23/2022153473574623119
145/22/20222917362461494331
155/21/20222917776575633523
165/20/20224937695748364533
175/19/202266547058131164
185/18/20227058402829172412
195/17/20226553786665535240
205/16/2022153251338268068
215/15/202221931192084230
225/14/20223624604847356957
235/13/2022443216456442513
245/12/2022726016427154836
255/11/20223321746237253523
265/10/2022524018668567765
275/9/20225947746237255846
285/8/20223624635148364735
295/7/202236245947131219
305/6/20223523332178665947
Sheet1
Click to expand...

Jon Peltier said:
I hope you mean every second COLUMN of data. Anyway, the following will do what you want. Adjust the constants at the top of the procedure to manipulate the chart positions.

VBA Code: 
Sub ChartMaker()
  Const ChartLeft As Double = 325
  Const ChartTop As Double = 10
  Const ChartWidth As Double = 600
  Const ChartHeight As Double = 300
  Const ChartGap As Double = 25
 
  Worksheets("Charts").Activate
 
  Dim DataRange As Range
  Set DataRange = ActiveSheet.UsedRange
 
  Dim XRange As Range
  With DataRange
    Set XRange = .Offset(1).Resize(.Rows.Count - 1, 1)
  End With

  Dim nCharts As Long
  nCharts = (DataRange.Columns.Count - 1) / 2
 
  Dim iChart As Long
  For iChart = 1 To nCharts
    Dim YRange As Range
    Set YRange = XRange.Offset(, 2 * iChart - 1)
    Dim SeriesName As Range
    Set SeriesName = YRange.Offset(-1).Resize(1)
   
    Dim ThisChart As Chart
    Set ThisChart = ActiveSheet.Shapes.AddChart2(, xlXYScatterLines, ChartLeft, _
      ChartTop + (ChartHeight + ChartGap) * (iChart - 1), ChartWidth, ChartHeight).Chart
   
    ThisChart.SetSourceData Union(XRange, YRange)
    ThisChart.SeriesCollection(1).Name = "=" & SeriesName.Address(, , , True)
    ThisChart.Parent.Name = SeriesName.Value2
  Next

End Sub
Click to expand...
John, crazy, but I was just on your website Peltiertech.com to help me figure out a way to do some of the chart sizing/movement!! I came up with something different than what you have above, but I can confirm that yours works. Thanks for the solution and the website.

My code which now also works.

VBA Code: 
Sub AddCharts()
' Adds a scatter chart for every other column
' Change Mod to another number to do all columns or some other division

    Dim rng As Range
    Dim Num As Long
    Dim topInc As Long
    Dim ParName As String
    
    topInc = 200
    
    For Each rng In Range("B2:I2").Columns
    
        If rng.Column Mod 2 = 0 Then
        
            With ActiveSheet.Shapes.AddChart.Chart
                .ChartType = xlXYScatter
                .SeriesCollection.NewSeries
                .Parent.Name = Cells(1, rng.Column).Value
                
                ParName = Cells(1, rng.Column).Value
                                
                With .SeriesCollection(1)
                    .XValues = "=" & ActiveSheet.Name & "!" & _
                        Range(Cells(2, 1), Cells(30, 1)).Address
                    .Name = "=" & ActiveSheet.Name & "!" & _
                        Cells(1, rng.Column).Address
                    .Values = "=" & ActiveSheet.Name & "!" & _
                        Range(Cells(2, rng.Column), Cells(30, rng.Column)).Address
                    
                    With ActiveSheet.ChartObjects(ParName)
                        .Height = 325
                        .Width = 500
                        .Top = 100 + topInc
                        .Left = 100
                    
                    End With
                        
                End With
            
            End With
                        
        End If

    topInc = topInc + 200

    Next rng

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Modifying a Donut Chart
Replies
3
Views
115
Kaper
Kaper
T
  • Solved
Setting up Two Pie charts in VBA
Replies
4
Views
165
TheTiredEngineer
T
A
  • Solved
VBA Help!
Replies
2
Views
383
AusNewb
A
N
  • Question Question
Pivot graph data when creating a new tab from a template.
Replies
0
Views
239
Nippyzap
N
G
  • Question Question
How to loop through data to generate charts
Replies
7
Views
111
HighAndWilder
H

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

Share this page

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