How can I create a chart from unique values in a range - excel

Question

I have items that are being populated on a worksheet via userform. When I open the workbook I'm trying to get the tool to go to the sheet grab the data and generate a chart/dashboard on the main landing sheet.
In the range of data contains statuses. I want VBA to look through one column of data and create a chart that counts each different status and put that in a bar chart.
yaxis = the different statuses
xaxis = count
my code so far
Sub populatecharts()
Dim ws As Worksheet
Dim ch As Chart
Dim tablerng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim sh As String
Set ws = ActiveSheet
'When the workbook opens it should always check the data and populate the BA Dashboard
'I need to check for sheets and if they exist generate a chart from the data
sh = "Action"
On Error Resume Next
Worksheets("Action").Visible = True
If CheckSheetExist(sh) = False Then
GoTo nextchart1
Else
Worksheets(sh).Activate
'Set ws = ActiveSheet
Set rng1 = Range("G4", Range("G4", "G4").End(xlDown))
rng1.Select
'Set rng2 = Range("B2")
'Set rng3 = Range("C3")
'Set tablerng = rng1 '& rng2 & rng3
Set ch = ws.Shapes.AddChart2(Width:=200, Height:=200, Left:=Range("B4").Left, Top:=Range("B4").Top).chart
With ch
.SetSourceData Source:=rng1
.ChartType = xlBarClustered
.ChartTitle.Text = "Action Items by Status"
End With
ws.Activate
Worksheets("Action").Visible = False
End If
Seems easy but I'm not able to think through it, also the location is hit or miss even though I define the top and bottom and size. Sometimes it's to the right of the cell I chose to be the left.

Answer 1

Try the next way, please. It uses a dictionary to extract the unique values and their count and array to feed the necessary series. Try running it on active sheet and adapt it to your situation only after having the confirmation that what it returns is what you need:
Sub populatecharts()
Dim shT As Worksheet, ch As Chart, lastRow As Long
Dim arrY, arrX, i As Long, dict As Object
Set shT = ActiveSheet 'use here the sheet you need
lastRow = shT.Range("G" & shT.Rows.count).End(xlUp).row
arrX = shT.Range("G4:G" & lastRow).Value 'put the range in a array
Set dict = CreateObject("Scripting.Dictionary") 'needed for the next step
On Error Resume Next
shT.ChartObjects("MyChartXY").Delete 'for the case of re running need
On Error GoTo 0
For i = 1 To UBound(arrX)
If Not dict.Exists(arrX(i, 1)) Then
dict(arrX(i, 1)) = 1 'create the unique keys
Else
dict(arrX(i, 1)) = dict(arrX(i, 1)) + 1 'increment the key next occurrrence
End If
Next i
arrX = dict.Keys: arrY = dict.Items 'extract the necessary arrays
Set ch = shT.ChartObjects.Add(left:=shT.Range("B4").left, _
top:=shT.Range("B4").top, width:=200, height:=200).Chart
With ch
.ChartType = xlBarClustered
.HasTitle = True
.ChartTitle.Text = "Action Items by Status"
.SeriesCollection.NewSeries.Values = arrY 'feed it with the array elements
.SeriesCollection(1).XValues = arrX 'feed it with the array elements
End With
End Sub
Please, test it and send some feedback.