Thread: VBA Loop through sheets and create charts

Hi everyone,

I need to write a macro that will run through all worksheets in a given file, creating charts for each of them.

The columns in each of the files/worksheets are always the same, but the number of rows vary. Blank cells are scattered here and there.

I wrote the following VBA script but it fails to work. I would appreciate advice.

I have an extra question as well: I cannot understand why a chart is created in a new sheet and not as an object in the active one?

Sub create_charts()
'
' create_charts Macro
' Macro recorded 2009-11-03 by pawlowir

MsgBox ("Open file")
Source = Application.GetOpenFilename
Workbooks.Open (Source)

Dim Sht As Worksheet

For Each Sht In ActiveWorkbook.Worksheets

   Sht.Activate

  Set LastCell = ActiveSheet.Cells(LastRow(Sht), LastCol(Sht))
  
   Charts.Add
   ActiveChart.ChartType = xlColumnClustered
  ActiveChart.SetSourceData Source:=Sheets(ActiveSheet.Range(Cells(5, 1), LastCell))
   ActiveChart.Location xlLocationAsObject, Name:=ActiveSheet.Name
   With ActiveChart
        Do Until .SeriesCollection.Count = 2
        .SeriesCollection(1).Delete
        Loop
   End With
   ActiveChart.SeriesCollection(1).XValues = Sheets(Active.Sheet).Range("R5C2:" & LastRow(Sht) & "C3")
   ActiveChart.SeriesCollection(1).Values = Sheets(Active.Sheet).Range("R5C14:" & LastRow(Sht) & "C14")
   ActiveChart.SeriesCollection(1).Name = Sheets(Active.Sheet).Range("R2C14:R3C14")
   ActiveChart.SeriesCollection(2).XValues = Sheets(Active.Sheet).Range("R5C2:" & LastRow(Sht) & "C3")
   ActiveChart.SeriesCollection(2).Values = Sheets(Active.Sheet).Range("R5C17:" & LastRow(Sht) & "C17")
   ActiveChart.SeriesCollection(2).Name = Sheets(Active.Sheet).Range("R2C17:R3C17")

    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = ActiveSheet.Name
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "DATE/MAKE"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "EDS"

Next Sht

End Sub

It is supported by two functions:

Function LastRow(ws As Worksheet)

On Error Resume Next

LastRow = ws.Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

On Error GoTo 0
End Function

and

Function LastCol(ws As Worksheet)

On Error Resume Next

LastCol = ws.Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column

On Error GoTo 0
End Function

Can you post example workbook so we can see the data layout. Also include an example of the chart.

FYI. the code charts.add is for create a new chart sheet.
If you want a chart object directly on the sheet then you need to use the add method of chartobjects

activesheet.chartobjects.add(1,1,100,100)

Sub MakeCharts()

    Dim shtData As Worksheet
    Dim objCht As Chart
    Dim rngXValues As Range
    Dim rngValues As Range
    
    For Each shtData In ActiveWorkbook.Worksheets
        Set objCht = shtData.ChartObjects.Add(15, 130, 700, 280).Chart
        ' remove any series added by excel
        Do While objCht.SeriesCollection.Count > 0
            objCht.SeriesCollection(1).Delete
        Loop
    
        Set rngXValues = shtData.Range("B5", shtData.Cells(shtData.Rows.Count, 3).End(xlUp))
        With objCht
            With .SeriesCollection.NewSeries
                .Values = rngXValues.Offset(0, 12).Resize(, 1)
                .XValues = rngXValues
                .Name = rngXValues.Offset(-3, 12).Resize(2, 1)
                .Interior.ColorIndex = 27
            End With
            With .SeriesCollection.NewSeries
                .Values = rngXValues.Offset(0, 15).Resize(, 1)
                .XValues = rngXValues
                .Name = rngXValues.Offset(-3, 15).Resize(2, 1)
                .Interior.ColorIndex = 30
            End With
            With .Axes(xlValue, xlPrimary)
                .HasTitle = True
                .AxisTitle.Text = "EDS"
            End With
            With .Axes(xlCategory, xlPrimary)
                .HasTitle = True
                .AxisTitle.Text = "DATE/MAKE"
            End With
            .HasTitle = True
            .ChartTitle.Text = shtData.Name
        End With
    Next
End Sub