Option Explicit
Sub MakeBarChart()
Dim wsData As Worksheet
Dim wsChart As Worksheet
Dim rECRLabels As Range
Dim rECRCounts As Range
Dim rChartDataRange As Range
Dim rAnchorCellECRData As Range
Dim rAnchorCellChartData As Range
Dim rActiveCell As Range
Dim iLoopIndex As Integer
Dim iEntriesCount As Long
Dim iTempVal As Long
Dim iColumns As Long
Dim dicECRs As Object
Dim vKey As Variant
Dim cResults As Chart
Dim sChartName As String
Dim sChartTitle As String
Set dicECRs = CreateObject("Scripting.Dictionary")
Set wsData = ThisWorkbook.Worksheets("ECRs")
Set wsChart = ThisWorkbook.Worksheets("ECRsChart")
Set rAnchorCellECRData = wsData.Range("A1")
Set rAnchorCellChartData = wsChart.Range("C2")
sChartTitle = "ECR Counts"
sChartName = "ECR Counts"
Set rActiveCell = ActiveCell
iLoopIndex = 0
rAnchorCellChartData.CurrentRegion.ClearContents
On Error Resume Next
wsChart.ChartObjects(sChartName).Delete
On Error GoTo 0
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) = ""
iEntriesCount = iLoopIndex - 1
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
Set rECRLabels = rAnchorCellChartData.Resize(1, dicECRs.Count)
Set rECRCounts = rAnchorCellChartData.Offset(1).Resize(1, dicECRs.Count)
rAnchorCellChartData.Offset(0, -1).Value = "ECRs"
rAnchorCellChartData.Offset(1, -1).Value = "Count"
iLoopIndex = 0
For Each vKey In dicECRs.Keys
iLoopIndex = iLoopIndex + 1
rECRLabels.Cells(1, iLoopIndex).Value = vKey
rECRCounts.Cells(1, iLoopIndex).Value = dicECRs(vKey)
Next vKey
Set rChartDataRange = rAnchorCellChartData.Offset(0, -1).Resize(2, dicECRs.Count + 1)
rChartDataRange.EntireColumn.AutoFit
Set cResults = wsChart.Shapes.AddChart.Chart
With cResults
.Parent.Name = sChartName
.ChartType = xlColumnClustered
.SetSourceData Source:=rChartDataRange
.HasTitle = True
.ChartTitle.Caption = sChartTitle
.Axes(xlValue).MajorUnit = 1
.HasLegend = False
End With
With wsChart.ChartObjects(sChartName)
.Top = rAnchorCellChartData.Offset(2, -1).Top
.Left = rAnchorCellChartData.Offset(2, -1).Left
Application.ScreenUpdating = True
.Activate
With ActiveChart.Axes(xlCategory)
.HasTitle = True
With .AxisTitle
.Caption = "ECRs"
End With
End With
With ActiveChart.Axes(xlValue)
.HasTitle = True
With .AxisTitle
.Caption = "Counts"
End With
End With
End With
With rActiveCell
.Parent.Activate
.Activate
End With
wsChart.Activate
rAnchorCellChartData.Offset(0, -1).Activate
End Sub