Forum Discussion

Aditya Jadhav's avatar
Aditya Jadhav
Brass Contributor
Dec 28, 2019
Solved

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

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

excel
Macros and VBA
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Dec 29, 2019

    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.

     

4 Replies

  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Silver Contributor
    Dec 28, 2019

    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
    • Aditya Jadhav's avatar
      Aditya Jadhav
      Brass Contributor
      Dec 29, 2019

      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

       

      • Subodh_Tiwari_sktneer's avatar
        Subodh_Tiwari_sktneer
        Silver Contributor
        Dec 29, 2019

        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.

         

Resources