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

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.