Help Setting Chart XValues to a Collection

[carstenp]

I have written some code that cycles through a series of data and adds values that meet certain criteria to various collections. I'm now wanting to change the X & Y values and Data Labels of my chart to reflect those in the collections, but am unsure how to do this. I've previously only used ranges for this logic, which works, and I suppose I could write the values in the collection to cells on Sheet15 and refer to the ranges that way, but it seems like there should be a better solution. Thanks in advance

Option ExplicitSub Update_Chart()
Application.ScreenUpdating = False


Dim Sector As String, SubSector As String
Dim ws As Worksheet
Dim rws As Integer, clmns As Integer, i As Integer
Dim XValuesCollection As Collection, YValuesCollection As Collection, LabelsCollection As Collection
Dim cht As Object, srs As Variant


    Set XValuesCollection = New Collection
    Set YValuesCollection = New Collection
    Set LabelsCollection = New Collection
    
    With Sheet15
        Sector = .Cells(2, 3)
        SubSector = .Cells(3, 3)
    End With
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = Sector Then
            With ws
                rws = .Cells(Rows.Count, 2).End(xlUp).Row
                clmns = .Cells(2, Columns.Count).End(xlToLeft).Column
            
                For i = 3 To rws
                    If .Cells(i, Application.Match("Sub-Sector", .Rows(2), 0)) = SubSector Then
                        XValuesCollection.Add (.Cells(i, Application.Match("TTM Revenue", .Rows(2), 0)).Value)
                        YValuesCollection.Add (.Cells(i, Application.Match("P/E", .Rows(2), 0)).Value)
                        LabelsCollection.Add (.Cells(i, Application.Match("Ticker", .Rows(2), 0)).Value)
                    End If
                Next i
            End With
            GoTo Jumpout
        End If
    Next ws
    
Jumpout:
    With Sheet15
        For Each cht In ws.ChartObjects
            For Each srs In cht.Chart.SeriesCollection
                With srs
                    .XValues = XValuesCollection
                    .Values = YValuesCollection
                    With .DataLabels
                        .Format.TextFrame2.TextRange.InsertChartField msoChartFieldRange, LabelsCollection, 0
                    End With
                End With
            Next srs
        Next cht
    End With


Application.ScreenUpdating = True
End Sub

 

[MoshiM]

I have written some code that cycles through a series of data and adds values that meet certain criteria to various collections. I'm now wanting to change the X & Y values and Data Labels of my chart to reflect those in the collections, but am unsure how to do this. I've previously only used ranges for this logic, which works, and I suppose I could write the values in the collection to cells on Sheet15 and refer to the ranges that way, but it seems like there should be a better solution. Thanks in advance

I would suggest compiling the items in your collection into a 1D array once you've finished adding to it and then supply the chart with the array instead.
https://docs.microsoft.com/en-us/office/vba/api/Excel.Series.XValues

 

[Domenic]

As per the suggestion by MoshiM, here's an example that fills an array with the desired values, and then replaces the first series of the specified chart with values from the array. Note that this example only deals with one set of data and a single chart. Also, it assumes that both the data and chart are located in "Sheet1", and that the chart is called "Chart 1". Change the names accordingly. Hopefully, you can adapt the code to suit your purposes.

Option Explicit

Sub test()

    Dim SubSector As String
    SubSector = "Sub-Sector"
    
    Dim cnt As Long
    Dim lastRow As Long
    Dim rowIndex
    Dim filteredArray() As Variant
    
    cnt = 0
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(.Rows.count, 2).End(xlUp).Row
        ReDim filteredArray(1 To 3, 1 To lastRow)
        For rowIndex = 3 To lastRow
            If .Cells(rowIndex, Application.Match("Sub-Sector", .Rows(2), 0)) = SubSector Then
                cnt = cnt + 1
                filteredArray(1, cnt) = .Cells(rowIndex, Application.Match("TTM Revenue", .Rows(2), 0)).Value
                filteredArray(2, cnt) = .Cells(rowIndex, Application.Match("P/E", .Rows(2), 0)).Value
                filteredArray(3, cnt) = .Cells(rowIndex, Application.Match("Ticker", .Rows(2), 0)).Value
            End If
        Next rowIndex
    End With


    Dim pointIndex As Long
    
    If cnt > 0 Then
        ReDim Preserve filteredArray(1 To 3, 1 To cnt)
        With ThisWorkbook.Worksheets("Sheet1").ChartObjects("Chart 1").Chart.SeriesCollection(1)
            .XValues = Application.Index(filteredArray, 1, 0)
            .Values = Application.Index(filteredArray, 2, 0)
            .ApplyDataLabels
            For pointIndex = 1 To .Points.count
                .Points(pointIndex).DataLabel.Format.TextFrame2.TextRange.Text = filteredArray(3, pointIndex)
            Next pointIndex
        End With
    Else
        MsgBox "No matches found for Sub-Sector " & SubSector & "!", vbExclamation
    End If


End Sub

Hope this helps!