VBA/Excel/Access/Word/Excel/Chart

Activates the ChartObject named Chart 1

 
Sub activate()
    ActiveSheet.ChartObjects("Chart 1").Activate
End Sub

Add Chart

 
Sub AddChart()
  Dim aChart As Chart
  ActiveSheet.ChartObjects.Delete
  Set aChart = Charts.Add
  Set aChart = aChart.Location(Where:=xlLocationAsObject, Name:="Sheet1")
  With aChart
    .ChartType = xlColumnClustered
    .SetSourceData Source:=Sheets("Sheet1").Range("A3:D7"), _
      PlotBy:=xlRows
    .HasTitle = True
    .ChartTitle.Text = "=Sheet1!R3C1"
    With .Parent
      .Top = Range("F3").Top
      .Left = Range("F3").Left
      .Name = "MangoesChart"
    End With
  End With
End Sub

Adding a Chart Sheet Using VBA Code

 
     Sub AddChartSheet()
         Dim myChart As Chart
         Set myChart = Charts.add
         With myChart
             .SetSourceData Source:=Sheets("Sheet1").range("A3:D7"), _
                           PlotBy:=xlRows
             .ChartType = xlColumnClustered
             .HasTitle = True
             .ChartTitle.text = "Mangoes"
         End With
     End Sub

Adding a New Series to the chart identified by the object variable myChart, drawing the data from the range C4:K4 on the active worksheet in the active workbook, using rows:

 
Sub series()
    Dim myChartObject As ChartObject
    Set myChartObject = ActiveSheet.ChartObjects.Add(Left:=200, Top:=200, _
        Width:=400, Height:=300)
    
    myChartObject.Chart.SetSourceData Source:= _
        ActiveWorkbook.Sheets("Chart Data").Range("A1:E5")
    
    myChartObject.SeriesCollection.Add Source:=ActiveSheet.Range("C4:K4"), Rowcol:=xlRows
End Sub

add the data labels using the following code:

 
     Sub AddDataLabels()
         Dim seSales As Series
         Dim pts As Points
         Dim pt As Point
         Dim rngLabels As range
         Dim iPointIndex As Integer
         Set rngLabels = range("B4:G4")
         Set seSales = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
         seSales.HasDataLabels = True
         Set pts = seSales.Points
         For Each pt In pts
             iPointIndex = iPointIndex + 1
             pt.DataLabel.text = rngLabels.cells(iPointIndex).text
             pt.DataLabel.font.bold = True
             pt.DataLabel.Position = xlLabelPositionAbove
         Next pt
     End Sub

Automatically generating a chart without user interaction

 
Sub CreateChart(r)
    Dim TempChart As Chart
    Application.ScreenUpdating = False
    
    Set CatTitles = ActiveSheet.range("A2:F2")
    Set SrcRange = ActiveSheet.range(Cells(r, 1), Cells(r, 6))
    Set SourceData = Union(CatTitles, SrcRange)
    
    Set TempChart = Charts.Add
    With TempChart
        .ChartType = xlColumnClustered
        .SetSourceData Source:=SourceData, PlotBy:=xlRows
        .HasLegend = False
        .ApplyDataLabels Type:=xlDataLabelsShowValue, _
         LegendKey:=False
        .ChartTitle.Font.Size = 14
        .ChartTitle.Font.Bold = True
        .Axes(xlValue).MaximumScale = 0.6
        .Axes(xlCategory).TickLabels.Font.Size = 10
        .Axes(xlCategory).TickLabels.Orientation = _
         xlHorizontal
        .Location Where:=xlLocationAsObject, name:="Sheet1"
    End With
    With ActiveSheet.ChartObjects(1)
        .Width = 300
        .Height = 150
        .Visible = False
    End With
End Sub

convert an existing chart to use arrays instead of cell references and make it independent of the original data

 
     Sub ConvertSeriesValuesToArrays()
         Dim seSeries As Series
         Dim myChart As Chart
         On Error GoTo Failure
         Set myChart = ActiveSheet.ChartObjects(1).Chart
         For Each seSeries In myChart.SeriesCollection
             seSeries.Values = seSeries.Values
             seSeries.XValues = seSeries.XValues
             seSeries.name = seSeries.name
         Next seSeries
         Exit Sub
Failure:
         MsgBox "Sorry, the data exceeds the array limits"""
     End Sub

Creating a Chart

 
Sub chart()
    Dim myChartSheet As Chart
    Set myChartSheet = ActiveWorkbook.Sheets.Add _
        (After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count), _
        Type:=xlChart)
End Sub

Creating a Chart on an Existing Worksheet

 
Sub charObj()
    Dim myChartObject As ChartObject
    Set myChartObject = ActiveSheet.ChartObjects.Add(Left:=200, Top:=200, _
        Width:=400, Height:=300)
End Sub

Creating a Chart Using the Chart Object

 
Sub CreateExampleChartVersionII() 
    Dim ws As Worksheet 
    Dim rgChartData As Range 
    Dim myChart As Chart 
    Set ws = ThisWorkbook.Worksheets("Basic Chart") 
    Set rgChartData = ws.Range("B1").CurrentRegion 
    Set myChart = Charts.Add 
    Set myChart = myChart.Location(xlLocationAsObject, ws.Name) 
    With myChart 
        .SetSourceData rgChartData, xlColumns 
        .HasTitle = True 
        .ChartTitle.Caption = "Version II" 
        .ChartType = xlColumnClustered 
        With .Axes(xlCategory) 
            .HasTitle = True 
            .AxisTitle.Caption = "Year" 
        End With 
        With .Axes(xlValue) 
            .HasTitle = True 
            .AxisTitle.Caption = "GDP in billions of $" 
        End With 
    End With 
    Set myChart = Nothing 
    Set rgChartData = Nothing 
    Set ws = Nothing 
End Sub

Creating an Embedded Chart

 
Public Sub AddEmbeddedChart()
    Dim dataRange As Range
    Set dataRange = ActiveWindow.Selection   "Chart selected data
    ActiveSheet.ChartObjects.Add Left:=200, Top:=50, Width:=500,Height:=350
    ActiveSheet.ChartObjects(1).Activate
    With ActiveChart      "Set chart properties
        .ChartType = xlColumnClustered
        .SeriesCollection.NewSeries
        .HasLegend = True
        .Legend.Position = xlRight
        .Axes(xlCategory).MinorTickMark = xlOutside
        .Axes(xlValue).MinorTickMark = xlOutside
        .Axes(xlValue).MaximumScale = Application.WorksheetFunction.RoundUp(Application.WorksheetFunction.Max(dataRange), -1)
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text ="X-axis Labels"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Y-axis"
        .SeriesCollection(1).name = "Sample Data"
        .SeriesCollection(1).Values = dataRange
    End With
End Sub

Creating a New Chart Using the ChartWizard Method

 
Sub CreateExampleChartVersionI() 
    Dim ws As Worksheet 
    Dim rgChartData As Range 
    Dim myChart As Chart 
    Set ws = ThisWorkbook.Worksheets("Sheet1") 
    Set rgChartData = ws.Range("B1").CurrentRegion 
    Set myChart = Charts.Add 
    Set myChart = myChart.Location(xlLocationAsObject, ws.Name) 
    With myChart 
        .ChartWizard _ 
            Source:=rgChartData, _ 
            Gallery:=xlColumn, _ 
            Format:=1, _ 
            PlotBy:=xlColumns, _ 
            CategoryLabels:=1, _ 
            SeriesLabels:=1, _ 
            HasLegend:=True, _ 
            Title:="Version I", _ 
            CategoryTitle:="Year", _ 
            ValueTitle:="GDP in billions of $" 
    End With 
    Set myChart = Nothing 
    Set rgChartData = Nothing 
    Set ws = Nothing 
End Sub

Creating a New Series, use the NewSeries method with the SeriesCollection collection.

 
Sub newSeries()
    Dim myChartObject As ChartObject
    Set myChartObject = ActiveSheet.ChartObjects.Add(Left:=200, Top:=200, _
        Width:=400, Height:=300)
    
    myChartObject.Chart.SetSourceData Source:= _
        ActiveWorkbook.Sheets("Chart Data").Range("A1:E5")
    
    myChartObject.SeriesCollection.Add Source:=ActiveSheet.Range("C4:K4"), Rowcol:=xlRows
    myChartObject.SeriesCollection.NewSeries
End Sub

Creating Charts

 
 
Common Excel Chart Types         
Chart      VBA Constant (ChartType property of Chart object)         
Column     xlColumnClustered, xlColumnStacked, xlColumnStacked100         
Bar        xlBarClustered, xlBarStacked, xlBarStacked100         
Line       xlLine, xlLineMarkersStacked, xlLineStacked         
Pie        xlPie, xlPieOfPie         
Scatter    xlXYScatter, xlXYScatterLines       

Public Sub AddChartSheet()
    Dim dataRange As Range
    Set dataRange = ActiveWindow.Selection
    Charts.Add   "Create a chart sheet
    With ActiveChart    "Set chart properties
        .ChartType = xlColumnClustered
        .HasLegend = True
"        .Legend.Position = xlRight
        .Axes(xlCategory).MinorTickMark = xlOutside
        .Axes(xlValue).MinorTickMark = xlOutside
        .Axes(xlValue).MaximumScale = _
                    Application.WorksheetFunction.RoundUp( _
                    Application.WorksheetFunction.Max(dataRange), -1)
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Characters.Text = "X-axis Labels"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Characters.Text = "Y-axis"
        .SeriesCollection(1).name = "Sample Data"
        .SeriesCollection(1).Values = dataRange
    End With
End Sub

Determining a chart"s source data

 
Sub Test1()
    Dim DataRange As range
    Set DataRange = ActiveSheet.range("A1:A2")
    ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Values = DataRange
End Sub

Extending an Existing Series in the chart identified by the object variable myChart using the data in the cells P3:P8 on the worksheet named Chart Data:

 
Sub chartSource()
    Dim myChartObject As ChartObject
    Set myChartObject = ActiveSheet.ChartObjects.Add(Left:=200, Top:=200, _
        Width:=400, Height:=300)
    
    myChartObject.Chart.SetSourceData Source:= _
        ActiveWorkbook.Sheets("Chart Data").Range("A1:E5")
    
    myChartObject.SeriesCollection.Add Source:=ActiveSheet.Range("C4:K4"), Rowcol:=xlRows
    myChartObject.SeriesCollection.Extend Source:=Worksheets("Chart Data").Range("P3:P8")
End Sub

Get Chart SeriesCollection value

 
Sub Test2()
    Dim DataRange As range
    Set DataRange = Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).Values
End Sub

Get Chart sheet

 
Public Sub GetChartSheets()
    Dim myCharts As Sheets
    Dim chSheet As Chart
    Set myCharts = ActiveWorkbook.Charts
    For Each chSheet In myCharts
        Debug.Print chSheet.name
    Next
End Sub

Get Embedded Charts

 
Public Sub GetEmbeddedCharts()
    Dim myChart As ChartObject
    Dim myCharts As ChartObjects
    Set myCharts = ActiveSheet.ChartObjects
    For Each myChart In myCharts
        Debug.Print myChart.Chart.name
    Next
End Sub

In most cases you can avoid using the worksheet Index property

 
     Sub InsertChartsBeforeWorksheets2()
           Dim myWorksheet As Worksheet
           For Each myWorksheet In Worksheets
           Charts.add Before:=myWorksheet
           Next myWorksheet
     End Sub

Insert chart sheets after each worksheet

 
     Sub InsertChartsAfterWorksheets()
           Dim myWorksheet As Worksheet
           Dim myChart As Chart
           For Each myWorksheet In Worksheets
           Set myChart = Charts.add
           myChart.Move After:=myWorksheet
           Next myWorksheet
     End Sub

Inserts a chart before each sheet

 
Sub InsertChartsBeforeWorksheets()
   Dim myWorksheet As Worksheet
 
   For Each myWorksheet In Worksheets
      Charts.Add Before:=Sheets(myWorksheet.Index)
   Next myWorksheet
End Sub

Inserts a chart before each sheet 2

 
Sub InsertChartsBeforeWorksheets2()
   Dim myWorksheet As Worksheet
 
   For Each myWorksheet In Worksheets
      Charts.Add Before:=myWorksheet
   Next myWorksheet
End Sub

Insert two chart sheets after the last worksheet in the active workbook. The chart sheets receive default names, such as Chart1 and Chart2:

 
Sub addAfter()
    ActiveWorkbook.Sheets.Add After:=Sheets(Sheets.Count), Count:=2, Type:=xlChart
End Sub

Modifying the chart type

 
Sub ModifyChart1()
    ActiveSheet.ChartObjects("Chart 1").activate
    ActiveChart.Type = xlArea
End Sub

Producing an Excel worksheet on a Word ocument

 
Sub MakeExcelChart()
    Dim XLSheet As Object
    
    Documents.Add
    Wbook = "\projections.xls"
    Set XLSheet = GetObject(Wbook, "Excel.Sheet").ActiveSheet
    
    XLSheet.range("Value") = 1
    XLSheet.range("Change") = 2
    XLSheet.Calculate
    Selection.Font.Size = 14
    Selection.Font.Bold = True
    Selection.TypeText "Monthly Increment: " & Format(2, "0.0%")
    Selection.TypeParagraph
    Selection.TypeParagraph
    XLSheet.range("data").Copy
    Selection.Paste
    
    XLSheet.ChartObjects(1).Copy
    Selection.PasteSpecial _
        Link:=False, _
        DataType:=wdPasteMetafilePicture, _
        Placement:=wdInLine, DisplayAsIcon:=False
    
    Set XLSheet = Nothing
End Sub

Reference Char object from ActiveSheet

 
Sub m()
    ActiveSheet.ChartObjects(1).Select
End Sub

Referencing Charts and Chart Objects in VBA Code

 
Sub SpecifyLocation()
    Dim WS As Worksheet
    Set WS = Worksheets("Sheet1")
    WS.Shapes.AddChart(xlColumnClustered, Left:=100, Top:=150, Width:=400, Height:=300).Select
    ActiveChart.SetSourceData Source:=WS.range("A1:E4")
End Sub

Retrieving data point labels from field names in the worksheet

 
Sub DataLabelsFromRange()
    Dim DLRange As range
    Dim myChart As Chart
    Dim i As Integer
    
    Set myChart = ActiveSheet.ChartObjects(1).Chart
    On Error Resume Next
    Set DLRange = Application.InputBox _
      (prompt:="Range for data labels?", Type:=8)
    If DLRange Is Nothing Then Exit Sub
    On Error GoTo 0
    myChart.SeriesCollection(1).ApplyDataLabels Type:=xlDataLabelsShowValue, AutoText:=True, LegendKey:=False
    Pts = myChart.SeriesCollection(1).Points.Count
    For i = 1 To Pts
        myChart.SeriesCollection(1). _
          Points(i).DataLabel.Characters.Text = DLRange(i)
    Next i
End Sub

Select a chart object

 
Sub m()
    ActiveWorkbook.Charts(1).Select
End Sub

Show chart

 
Sub ShowChart()
    UserRow = ActiveCell.Row
    If UserRow < 2 Or IsEmpty(Cells(UserRow, 1)) Then
        MsgBox "Move the cell cursor to a row that contains data."
        Exit Sub
    End If
    CreateChart (UserRow)
End Sub

Specify Exact Location

 
Sub SpecifyExactLocation()
    Dim WS As Worksheet
    Set WS = Worksheets("Sheet1")
    WS.Shapes.AddChart(xlColumnClustered, _
        Left:=WS.range("C11").Left, _
        Top:=WS.range("C11").Top, _
        Width:=WS.range("C11:J11").Width, _
        Height:=WS.range("C11:C30").Height).Select
    ActiveChart.SetSourceData Source:=WS.range("A1:E4")
End Sub

Specifying the Chart Type

 
Sub chartType()
    Dim myChartObject As ChartObject
    Set myChartObject = ActiveSheet.ChartObjects.Add(Left:=200, Top:=200, _
        Width:=400, Height:=300)
    
    myChartObject.Chart.SetSourceData Source:= _
        ActiveWorkbook.Sheets("Chart Data").Range("A1:E5")
    myChartObject.ChartType = xlColumnStacked
End Sub

Specifying the Source Data for the Chart by using the SetSourceData method of the Chart object

 
Sub width()
    Dim myChartObject As ChartObject
    Set myChartObject = ActiveSheet.ChartObjects.Add(Left:=200, Top:=200, _
        Width:=400, Height:=300)
    
    myChartObject.Chart.SetSourceData Source:= _
        ActiveWorkbook.Sheets("Chart Data").Range("A1:E5")
End Sub

To ensure that a chart is selected, you can add a statement to determine if a chart is active.

 
Sub ChartMods2()
    If ActiveChart Is Nothing Then
        MsgBox "Activate a chart."
        Exit Sub
    End If
    ActiveChart.Type = xlArea
    ActiveChart.ChartArea.font.name = "Calibri"
    ActiveChart.ChartArea.font.FontStyle = "Regular"
    ActiveChart.ChartArea.font.Size = 9
    ActiveChart.PlotArea.Interior.ColorIndex = xlNone
    ActiveChart.Axes(xlValue).TickLabels.font.bold = True
    ActiveChart.Axes(xlCategory).TickLabels.font.bold = True
    ActiveChart.Legend.Position = xlBottom
End Sub

Use For Each to loop through all chart objects

 
Sub ChangeCharts()
    Dim myChart As ChartObject
    For Each myChart In Sheets("Sheet1").ChartObjects
        myChart.Chart.ChartType = xlLine
    Next myChart
End Sub