Option Explicit
Sub MakeBarChart()
' ------------------------------
' Declarations
' ------------------------------
Dim wsData As Worksheet 'Worksheet that contains the data.
Dim wsChart As Worksheet 'Worksheet that contains the chart.
Dim rECRLabels As Range 'Range containing ECR labels.
Dim rECRCounts As Range 'Range containing ECR counts.
Dim rChartDataRange As Range 'Range where all chart data is located.
Dim rAnchorCellECRData As Range 'Upperleftmost cell where ECR data is located.
Dim rAnchorCellChartData As Range 'Upperleftmost cell where chart data is located.
Dim rActiveCell As Range
Dim iLoopIndex As Integer 'Used for looping ECRs
Dim iEntriesCount As Long
Dim iTempVal As Long
Dim iColumns As Long
Dim dicECRs As Object 'Excel Dictionary contains ECR labels and counts.
Dim vKey As Variant 'Used with dictionary to set dictionary keys.
Dim cResults As Chart 'Chart object.
Dim sChartName As String 'name of the chart
Dim sChartTitle As String 'title at the top of the chart
' ------------------------------
' Initializations
' ------------------------------
' Create the dictionary object.
Set dicECRs = CreateObject("Scripting.Dictionary")
Set wsData = ThisWorkbook.Worksheets("ECRs") '<= Worksheet containing data. Change as needed.
Set wsChart = ThisWorkbook.Worksheets("ECRsChart") '<= Worksheet containing the chart. Change as needed.
Set rAnchorCellECRData = wsData.Range("A1") '<= This is the upperleftmost cell containing the ECR data in wsData.
' It is the data's header. Change as needed.
Set rAnchorCellChartData = wsChart.Range("C2") '<= This is the upperleftmost cell in wsChart where chart is located
' in worksheet wsChart. Change as needed.
sChartTitle = "ECR Counts" '<= This is the title shown at the top of the chart. Change as needed.
sChartName = "ECR Counts"
Set rActiveCell = ActiveCell
iLoopIndex = 0
' -------------------------------------------
' Clear Existing Data and Chart
' -------------------------------------------
' Clear chart data.
rAnchorCellChartData.CurrentRegion.ClearContents
' Delete the existing chart if it exists.
On Error Resume Next
wsChart.ChartObjects(sChartName).Delete
On Error GoTo 0
' -------------------------------------------
' Get List of Unique ECRs
' -------------------------------------------
' Use an Excel dictionary dicECRs to gather a list of unique ECRs. Loop all ECRs.
Do
iLoopIndex = iLoopIndex + 1
If rAnchorCellECRData.Offset(iLoopIndex) <> "" _
Then
On Error Resume Next
dicECRs.Add Key:=rAnchorCellECRData.Offset(iLoopIndex).Value
dicECRs(rAnchorCellECRData.Offset(iLoopIndex).Value) = 0
On Error GoTo 0
End If
Loop Until rAnchorCellECRData.Offset(iLoopIndex) = ""
' Get count of all ECR entries. Minus one because Do loop does an extra iteration.
iEntriesCount = iLoopIndex - 1
' -------------------------------------------
' Get Count of Unique ECRs
' -------------------------------------------
' Use the Excel dictionary dicECRs to gather the count of unique ECRs.
' Loop all dictionary entries.
For Each vKey In dicECRs.Keys
For iLoopIndex = 1 To iEntriesCount
If rAnchorCellECRData.Offset(iLoopIndex) = vKey _
Then
iTempVal = dicECRs(vKey)
dicECRs(vKey) = iTempVal + 1
End If
Next iLoopIndex
Next vKey
' -------------------------------------------
' Setup Chart Data Ranges
' -------------------------------------------
' Set range where ECR names will be located for the chart (from dictionary).
Set rECRLabels = rAnchorCellChartData.Resize(1, dicECRs.Count)
' Set range where ECR counts will be located for the chart (from dictionary).
Set rECRCounts = rAnchorCellChartData.Offset(1).Resize(1, dicECRs.Count)
' Set data rows' names in worksheet.
rAnchorCellChartData.Offset(0, -1).Value = "ECRs"
rAnchorCellChartData.Offset(1, -1).Value = "Count"
iLoopIndex = 0
' Fill the two worksheet data rows -- labels and counts -- that make up the chart data.
For Each vKey In dicECRs.Keys
iLoopIndex = iLoopIndex + 1
rECRLabels.Cells(1, iLoopIndex).Value = vKey
rECRCounts.Cells(1, iLoopIndex).Value = dicECRs(vKey)
Next vKey
' ------------------------------------------------------------
' Create and Format the Chart in Specified Worksheet
' ------------------------------------------------------------
' Set range where data for the chart is located. Includes ECR names,
' ECR counts and row labels for ECRs and ECR counts.
Set rChartDataRange = rAnchorCellChartData.Offset(0, -1).Resize(2, dicECRs.Count + 1)
' Autofit the columns with data.
rChartDataRange.EntireColumn.AutoFit
' Create the new chart.
Set cResults = wsChart.Shapes.AddChart.Chart
' Set some characteristics of the chart.
With cResults
' Give the chart a name.
.Parent.Name = sChartName
' Specify the chart type.
.ChartType = xlColumnClustered
' Specify the location of the data.
.SetSourceData Source:=rChartDataRange
' Set the chart title
.HasTitle = True
.ChartTitle.Caption = sChartTitle
' Set the ajor units to 1 for "integers"
.Axes(xlValue).MajorUnit = 1
' Delete the legend for the chart because there is only one data series.
.HasLegend = False
End With
' More chart formatting.
With wsChart.ChartObjects(sChartName)
' Put the chart just below the data.
.Top = rAnchorCellChartData.Offset(2, -1).Top
.Left = rAnchorCellChartData.Offset(2, -1).Left
Application.ScreenUpdating = True
' Activate the chart to format axes.
.Activate
' Put the series label into the charts Y axis.
With ActiveChart.Axes(xlCategory)
.HasTitle = True
With .AxisTitle
.Caption = "ECRs"
End With
End With
' Put the label into the chart's X axis.
With ActiveChart.Axes(xlValue)
.HasTitle = True
With .AxisTitle
.Caption = "Counts"
End With
End With
End With
' ----------------------------------------------
' Activate Chart Sheet, First Data Cell
' ----------------------------------------------
With rActiveCell
.Parent.Activate
.Activate
End With
wsChart.Activate
rAnchorCellChartData.Offset(0, -1).Activate
End Sub
