Search code examples
excelvbauniqueexcel-charts

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


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.

enter image description here


Solution

  • 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.