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 ...
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.

     

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
  • almagda's avatar
    almagda
    Copper Contributor
    Apr 15, 2021

    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. 

  • 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