Charts and Graphs - VBA Examples
Charts and graphs are an ideal way to pictorially represent data. Many of my projects required them to enhance the visual impact of the data. When researching how to code them in VBA, most examples use the Select statement which requires that the worksheet containing the chart or graph is active. There are many occasions when I didn't want to have to activate the worksheet containing the chart or graph. With the assistance of Hans Vogelaar, a Microsoft MVP, I developed bar and pie charts that do not require the worksheet containing the embedded chart to be active. Here is an example of code that eliminates the need to activate and select the worksheet containing the chart.
Useful references:
https://www.thespreadsheetguru.com/blog/2015/3/1/the-vba-coding-guide-for-excel-charts-graph
https://peltiertech.com/Excel/Charts/ChartIndex.html
Program Code
Sub DeleteGraphicalChartObjects()
' ***********************************************************************
' Delete All Chart Objects On The Sales Monthly Report
' ***********************************************************************
Dim wkbCommissionsWorkbook As Workbook
Dim wksSalesHistory As Worksheet
Dim wksGraphicsReport As Worksheet
Dim wksGraphicsChartParameters As Worksheet
Dim chtObj As ChartObject
Set wkbCommissionsWorkbook = ThisWorkbook
Set wksSalesHistory = wkbCommissionsWorkbook.Sheets(gblMthRepOrAssociateName)
Set wksGraphicsReport = wkbCommissionsWorkbook.Sheets("GraphicsReport")
Set wksGraphicsChartParameters = wkbCommissionsWorkbook.Sheets("GraphicChartParameters")
For Each chtObj In wksGraphicsReport.ChartObjects
chtObj.Delete
Next
End Sub
Sub CreatePieChartGraphics()
' ************************************************************************************
' ************************************************************************************
' ************************************************************************************
' Charting VBA Code
' ************************************************************************************
' ************************************************************************************
' ************************************************************************************
' ************************************************************************************
' Calling Pie Chart For Current Month
' ************************************************************************************
Dim strChartTitle As String
Dim dblLeft As Double
Dim dblWidth As Double
Dim dblTop As Double
Dim dblHeight As Double
strChartTitle = "MRR vs Non-MRR " & gblActualRunDate
dblLeft = 5
dblWidth = 320
dblTop = 580
dblHeight = 170
Call CreatePieChart(strChartTitle, dblLeft, dblWidth, dblTop, dblHeight)
End Sub
' ************************************************************************************
' Pie Chart For Current Month No Select
' ************************************************************************************
Sub CreatePieChart(chartTitle As String, dblLeft As Double, dblWidth As Double, dblTop As Double, dblHeight As Double)
Dim wkbCommissionsReports As Workbook
Dim wksCommissionsReports As Worksheet
Dim newChart As Shape
Dim txtChartName As String
Set wkbCommissionsReports = ThisWorkbook
Set wksCommissionsReports = wkbCommissionsReports.Sheets("GraphicsReport")
Set newChart = wksCommissionsReports.Shapes.AddChart
With newChart
.Left = dblLeft
.Width = dblWidth
.Top = dblTop
.Height = dblHeight
With .Chart
.SetSourceData Source:=Worksheets("GraphicChartParameters").Range("A6:B7")
.ChartType = xlPie
.HasTitle = True
.chartTitle.Select
.chartTitle.Text = chartTitle
.SeriesCollection(1).ApplyDataLabels
.FullSeriesCollection(1).DataLabels.Format.TextFrame2.TextRange.Font.Bold = msoTrue
.FullSeriesCollection(1).DataLabels.Format.TextFrame2.TextRange.Font.Size = 11
.SeriesCollection(1).Points.Item(1).Interior.Color = RGB(153, 204, 255)
End With
End With
End Sub
' ************************************************************************************
' Pie Chart For Current Month With Select (For History Only - Don't Use This
' ************************************************************************************
Sub CreatePieCharSelect(chartTitle As String, dblLeft As Double, dblWidth As Double, dblTop As Double, dblHeight As Double)
Dim newChart As Shape
Set newChart = ActiveSheet.Shapes.AddChart
With newChart
.Left = dblLeft
.Width = dblWidth
.Top = dblTop
.Height = dblHeight
.Select
With .Chart
.ChartType = xlPie
.HasTitle = True
.chartTitle.Select
.chartTitle.Text = chartTitle
.SetSourceData Source:=Worksheets("GraphicChartParameters").Range("A6:B8")
.SeriesCollection(1).Select
.SeriesCollection(1).ApplyDataLabels
.FullSeriesCollection(1).DataLabels.Select
End With
Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue
Selection.Format.TextFrame2.TextRange.Font.Size = 11
.Chart.SeriesCollection(1).Points.Item(1).Interior.Color = RGB(153, 204, 255)
End With
End Sub
Sub CreateBarChartMRRGraphics()
' ************************************************************************************
' Calling Bar Chart for MRR 12 Month Graph
' ************************************************************************************
Dim strChartTitle As String
Dim dblLeft As Double
Dim dblWidth As Double
Dim dblTop As Double
Dim dblHeight As Double
strChartTitle = "Monthly MRR " & gblActualRunDate
dblLeft = 5
dblWidth = 320
dblTop = 760
dblHeight = 170
Call CreateBarChartMRR(strChartTitle, dblLeft, dblWidth, dblTop, dblHeight)
End Sub
Sub CreateBarChartMRR(chartTitle As String, dblLeft As Double, dblWidth As Double, dblTop As Double, dblHeight As Double)
' ************************************************************************************
' Bar Chart for MRR 12 Month Graph
' ************************************************************************************
Dim wkbCommissionsReports As Workbook
Dim wksCommissionsReports As Worksheet
Dim newChart As Shape
Dim txtChartName As String
Set wkbCommissionsReports = ThisWorkbook
Set wksCommissionsReports = wkbCommissionsReports.Sheets("GraphicsReport")
Set newChart = wksCommissionsReports.Shapes.AddChart
txtChartName = newChart.Name
With newChart
.Left = dblLeft
.Width = dblWidth
.Top = dblTop
.Height = dblHeight
With .Chart
.ChartType = xlColumnClustered
.HasTitle = True
.chartTitle.Text = chartTitle
.HasLegend = False
.SetSourceData Source:=Worksheets("GraphicChartParameters").Range("A11:L12")
.SeriesCollection(1).Trendlines.Add(Type:=xlLinear, Forward:=0, _
Backward:=0, DisplayEquation:=False, DisplayRSquared:=False).Select
End With
End With
End Sub
Sub CreateBarChartNon_MRRGraphics()
' ************************************************************************************
' Calling Bar Chart for Non_MRR 12 Month Graph
' ************************************************************************************
Dim strChartTitle As String
Dim dblLeft As Double
Dim dblWidth As Double
Dim dblTop As Double
Dim dblHeight As Double
strChartTitle = "Monthly Non-MRR " & gblActualRunDate
dblLeft = 335
dblWidth = 320
dblTop = 760
dblHeight = 170
Call CreateBarChartNon_MRR(strChartTitle, dblLeft, dblWidth, dblTop, dblHeight)
End Sub
Sub CreateBarChartNon_MRR(chartTitle As String, dblLeft As Double, dblWidth As Double, dblTop As Double, dblHeight As Double)
' ************************************************************************************
' Calling Bar Chart for Non_MRR 12 Month Graph
' ************************************************************************************
Dim wkbCommissionsReports As Workbook
Dim wksCommissionsReports As Worksheet
Dim newChart As Shape
Dim txtChartName As String
Set wkbCommissionsReports = ThisWorkbook
Set wksCommissionsReports = wkbCommissionsReports.Sheets("GraphicsReport")
Set newChart = wksCommissionsReports.Shapes.AddChart
With newChart
.Left = dblLeft
.Width = dblWidth
.Top = dblTop
.Height = dblHeight
With .Chart
.ChartType = xlColumnClustered
.HasTitle = True
.chartTitle.Text = chartTitle
.HasLegend = False
.SetSourceData Source:=Worksheets("GraphicChartParameters").Range("A22:L23")
.SeriesCollection(1).Trendlines.Add(Type:=xlLinear, Forward:=0, _
Backward:=0, DisplayEquation:=False, DisplayRSquared:=False).Select
End With
End With
End Sub
Sub CreateMRR_Non_MRRCompareChart()
' ************************************************************************************
' Calling Bar Chart MRR vs Non-MRR for 12 Months
' ************************************************************************************
Dim strChartTitle As String
Dim dblLeft As Double
Dim dblWidth As Double
Dim dblTop As Double
Dim dblHeight As Double
strChartTitle = "MRR vs Non-MMR Commissions " & gblActualRunDate
dblLeft = 335
dblWidth = 320
dblTop = 580
dblHeight = 170
Call MRR_Non_MRRCompareChart(strChartTitle, dblLeft, dblWidth, dblTop, dblHeight)
End Sub
Sub MRR_Non_MRRCompareChart(chartTitle As String, dblLeft As Double, dblWidth As Double, dblTop As Double, dblHeight As Double)
' ************************************************************************************
' Bar Chart MRR vs Non-MRR for 12 Months
' ************************************************************************************
Dim wkbCommissionsReports As Workbook
Dim wksCommissionsReports As Worksheet
Dim newChart As Shape
Dim txtChartName As String
Set wkbCommissionsReports = ThisWorkbook
Set wksCommissionsReports = wkbCommissionsReports.Sheets("GraphicsReport")
Set newChart = wksCommissionsReports.Shapes.AddChart
With newChart
.Left = dblLeft
.Width = dblWidth
.Top = dblTop
.Height = dblHeight
With .Chart
.ChartType = xlColumnClustered
.HasTitle = True
.chartTitle.Text = chartTitle
.HasLegend = True
.SetSourceData Source:=Worksheets("GraphicChartParameters").Range("A16:L18")
.SeriesCollection(1).Name = "=""Sum of MRR"""
.SeriesCollection(2).Name = "=""Sum of Non-MRR"""
.SeriesCollection(1).Trendlines.Add(Type:=xlLinear, Forward:=0, _
Backward:=0, DisplayEquation:=False, DisplayRSquared:=False, Name:="MRR Trend").Select
.SeriesCollection(2).Trendlines.Add(Type:=xlLinear, Forward:=0, _
Backward:=0, DisplayEquation:=False, DisplayRSquared:=False, Name:="Non-MRR Trend").Select
With .SeriesCollection(1).Trendlines(1)
.Border.ColorIndex = 41
.Border.Weight = xlMedium
.Border.LineStyle = xlContinuous
End With
With .SeriesCollection(2).Trendlines(1)
.Border.ColorIndex = 46
.Border.Weight = xlMedium
.Border.LineStyle = xlContinuous
End With
End With
End With
End Sub
'**************************************************************
' The Following Code Uses the Select Statement and requires
' the worksheet be active. I try to avoid using this
' method.
'**************************************************************
Function CreateCharts(strChartSheetName As String)
Dim cht As ChartObject
Dim strChartDataRange As String
Set cht = ActiveSheet.ChartObjects.Add( _
Left:=Cells(12, 9).Left, _
Width:=350, _
Top:=Cells(1, 9).Top, _
Height:=250)
' *************************************************************************************************
' The Range is specified in this format:
' Range("Template!$A$19:$A$44,Template!$G$19:$G$44")
' This shows the Horizontal and Vertical Axis Data
' cht.Chart.SetSourceData Source:=Range("Template!$A$19:$A$44,Template!$G$19:$G$44")
' See https://www.thespreadsheetguru.com/blog/2015/3/1/the-vba-coding-guide-for-excel-charts-graph
' *************************************************************************************************
'strChartDataRange = "Template!$A$" & lngChartDataRowStart & ":$A$" & lngChartDataRowEnd & ",Template!$G$" & lngChartDataRowStart & ":$G$" & lngChartDataRowEnd
strChartDataRange = "Template!$A$" & lngChartDataRowStart & ":$A$" & lngChartDataRowEnd & _
",Template!$" & strLineTotalColumnAlpha & "$" & lngChartDataRowStart & ":$" & strLineTotalColumnAlpha & "$" & lngChartDataRowEnd
cht.Chart.SetSourceData Source:=Range(strChartDataRange)
cht.Chart.ChartType = xlColumnClustered
cht.Chart.HasTitle = True
cht.Chart.ChartTitle.Text = strChartSheetName
cht.Select
ActiveChart.Location Where:=xlLocationAsNewSheet
ActiveSheet.Name = strChartSheetName
' *************************************************************************************************
' Move the graphic sheet to the end - This will only move to the 2nd position, so I need
' to add the charts in reverse order.
' *************************************************************************************************
wkbAlarmApplication.Sheets(strChartSheetName).Move after:=Sheets(Sheets.Count)
' *************************************************************************************************
' Activate the main worksheet
' *************************************************************************************************
wksTemplate.Activate
wksTemplate.Cells(1, 1).Select
End Function