SOLVED

How to create separate chart for each worksheet in a workbook using VBA ?

Brass Contributor

Hello all,

 

I have a workbook which contains more than 1000 worksheets in it and got them by using the pivot report filter. Now I need to create chart for each sheet and need help to get a VBA to do that. Now all the data is in the same range for all the sheets across the workbook, Need to create a chart where I need a combo chart type which has been prepared in the workbook. Need some help to make them as I have a very little time to make it work. As I do not have any knowledge about VBA hence this post. Would be very thankful for your help.

 

Attaching the file for reference.

 

Regards,

Aditya

4 Replies

@Aditya Jadhav 

You may try something like this...

Sub InsertCharts()
Dim ws As Worksheet
Dim pt As PivotTable
Dim Rng As Range
Dim ch As Chart
For Each ws In ThisWorkbook.Worksheets
    If ws.PivotTables.Count > 0 Then
        Set pt = ws.PivotTables(1)
        Set Rng = pt.TableRange2
        Set ch = ws.Shapes.AddChart(xlLine).Chart
        With ch
            .SetSourceData Source:=Rng
            .FullSeriesCollection("Rainfall ").ChartType = xlColumnClustered
            .FullSeriesCollection("Rainfall ").AxisGroup = 2
            .ShowAllFieldButtons = False
            .SetElement (msoElementLegendBottom)
            .HasTitle = True
            .ChartTitle.Characters.Text = ws.Name
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "RWL in m (above MSL)"
            .Axes(xlValue, xlSecondary).HasTitle = True
            .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Rainfall (mm)"
            .ChartArea.Left = Range("L3").Left
            .ChartArea.Top = Range("L3").Top
        End With
    End If
Next ws
End Sub

@Subodh_Tiwari_sktneer 

Thank you for the code it really worked very well. But there is one problem I need the primary and secondary axis scale to be fixed. On the primary axis, it needs the scale from 450 to 610 and on the secondary axis, it needs to be from 0 to 60. Can you please tell me how to add that and run it so then it will work completely as per my need.

Also, can you also tell me how can I export all these graphs to a powerpoint presentation where on one slide 4 graphs can be pasted.

 

Regards,

Aditya

 

best response confirmed by Aditya Jadhav (Brass Contributor)
Solution

@Aditya Jadhav 

Please give this a try....

Sub InsertCharts()
Dim ws As Worksheet
Dim pt As PivotTable
Dim Rng As Range
Dim ch As Chart
For Each ws In ThisWorkbook.Worksheets
    If ws.PivotTables.Count > 0 Then
        Set pt = ws.PivotTables(1)
        Set Rng = pt.TableRange2
        Set ch = ws.Shapes.AddChart(xlLine).Chart
        With ch
            .SetSourceData Source:=Rng
            .FullSeriesCollection("Rainfall ").ChartType = xlColumnClustered
            .FullSeriesCollection("Rainfall ").AxisGroup = 2
            .Axes(xlValue).MinimumScale = 450
            .Axes(xlValue).MaximumScale = 610
            .Axes(xlValue, xlSecondary).MinimumScale = 0
            .Axes(xlValue, xlSecondary).MaximumScale = 60
            .ShowAllFieldButtons = False
            .SetElement (msoElementLegendBottom)
            .HasTitle = True
            .ChartTitle.Characters.Text = ws.Name
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "RWL in m (above MSL)"
            .Axes(xlValue, xlSecondary).HasTitle = True
            .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Rainfall (mm)"
            .ChartArea.Left = Range("L3").Left
            .ChartArea.Top = Range("L3").Top
        End With
    End If
Next ws
End Sub

 

For PowerPoint question, please open a new question and I am sure other experts would be able to help you.

 

If that takes care of your original question, please accept the post with the proposed solution as a Best Response/Answer to mark your question as Solved.

 

@Subodh_Tiwari_sktneer 

How could the above code be adapted in case the excel workbook is not a report Pivot table? 

See attached. 

 

thank you in advance. 

1 best response

Accepted Solutions
best response confirmed by Aditya Jadhav (Brass Contributor)
Solution

@Aditya Jadhav 

Please give this a try....

Sub InsertCharts()
Dim ws As Worksheet
Dim pt As PivotTable
Dim Rng As Range
Dim ch As Chart
For Each ws In ThisWorkbook.Worksheets
    If ws.PivotTables.Count > 0 Then
        Set pt = ws.PivotTables(1)
        Set Rng = pt.TableRange2
        Set ch = ws.Shapes.AddChart(xlLine).Chart
        With ch
            .SetSourceData Source:=Rng
            .FullSeriesCollection("Rainfall ").ChartType = xlColumnClustered
            .FullSeriesCollection("Rainfall ").AxisGroup = 2
            .Axes(xlValue).MinimumScale = 450
            .Axes(xlValue).MaximumScale = 610
            .Axes(xlValue, xlSecondary).MinimumScale = 0
            .Axes(xlValue, xlSecondary).MaximumScale = 60
            .ShowAllFieldButtons = False
            .SetElement (msoElementLegendBottom)
            .HasTitle = True
            .ChartTitle.Characters.Text = ws.Name
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "RWL in m (above MSL)"
            .Axes(xlValue, xlSecondary).HasTitle = True
            .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Rainfall (mm)"
            .ChartArea.Left = Range("L3").Left
            .ChartArea.Top = Range("L3").Top
        End With
    End If
Next ws
End Sub

 

For PowerPoint question, please open a new question and I am sure other experts would be able to help you.

 

If that takes care of your original question, please accept the post with the proposed solution as a Best Response/Answer to mark your question as Solved.

 

View solution in original post