Sort Chart In Descending Order-CodePudding

Wondering if it was possible to sort chart data display in descending order :

I've no Idea of how to do so.

The only thing I know is how to browse series values :

Set s = cht.FullSeriesCollection(1)
    For i = 1 To s.Points.Count
        If s.Values(i) < 0 Then 'JustAnExample
            'WhateverIwant
        End If
    Next i

In addition, the above chart is built with data from a worksheet :

CodePudding user response：

Please, test the next solution. Since you did not post your chart creation code, I imagined something doing that:

Sub createStackedColChart_Arrays()
 Dim sh As Worksheet, arr1, arr2, arrN, arrD
 Dim chartName As String, arrSort, i As Long
 
 Set sh = ActiveSheet 'use here the necessary sheet
 chartName = "MyChartSorted"
 arr1 = sh.Range("A2:D2").value 'first series array
 arr2 = sh.Range("A3:D3").value 'second series array
 arrN = sh.Range("A1:D1").value 'X axes values array

 'Create the reference array of summarized values per column:
 ReDim arrSort(1 To UBound(arr1, 2))
 For i = 1 To UBound(arr1, 2)
      arrSort(i) = arr1(1, i)   CLng(arr2(1, i))
 Next i
 '_______________________________________________

 'sort arrays according to reference one (arrSort):
 sortArrs arrSort, arrN, arr1, arr2 

 'if the (testing) chart exists, delete it:
 On Error Resume Next
   ActiveSheet.ChartObjects(chartName).Delete
 On Error GoTo 0
 
 'create the necessary chart:
 With ActiveSheet.ChartObjects.Add(left:=100, width:=375, top:=75, height:=225).Chart
    .Parent.Name = chartName                  'name it to have a reference when delete it
    .SeriesCollection.NewSeries.Values = arr1 'add first series
    .SeriesCollection.NewSeries.Values = arr2 'add first series
    .HasTitle = True                          'set it to allow a Title
    .chartTitle.text = "My Sorted Chart"      'set the Title
    .ChartType = xlColumnStacked              'set the chart type
    .SeriesCollection(1).XValues = arrN       'add values to X axis
 End With
End Sub

Sub sortArrs(arrS, arrN, arr1, arr2) 'being passed byRef, the initial arrays are filtered
    Dim i As Long, nxtEl As Long, tmp, tmpN, tmp1, tmp2
    For i = LBound(arrS) To UBound(arrS) - 1 'iterate between the arrS elements (except the last):
        For nxtEl = i   1 To UBound(arrS)    'iterate between the arrS elements (starting from the second one):
            If arrS(i) < arrS(nxtEl) Then    'sort the arrays according to the element values (< means descending)
                tmp = arrS(i): tmpN = arrN(1, i): tmp1 = arr1(1, i): tmp2 = arr2(1, i)
                arrS(i) = arrS(nxtEl): arrN(1, i) = arrN(1, nxtEl)
                     arr1(1, i) = arr1(1, nxtEl): arr2(1, i) = arr2(1, nxtEl)
                arrS(nxtEl) = tmp: arrN(1, nxtEl) = tmpN
                    arr1(1, nxtEl) = tmp1: arr2(1, nxtEl) = tmp2
            End If
        Next nxtEl
    Next i
End Sub

Please, send some feedback after testing it.

If you need the chart being dynamic, meaning to refresh it in case of any value changed in the referenced range (A1:D3, in your example), sheet Change event can be used. If a change in the above mentioned range, the event will call the above function. If need it, please copy the next code in the involved sheet code module:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("A1:D3")) Is Nothing Then
        createStackedColChart_Arrays 'if need to change the Sub name, please adapt it here...
    End If
End Sub

Edited:

A more elaborated, dynamic version using all existing rows/columns in the sheet. The last column is calculated on the first row (column Headers):

Sub createStackedColChart_Arrays_Dynamic()
 Dim sh As Worksheet, lastR As Long, lastCol As String, arrN, arrSort
 Dim chartName As String, dict As Object, i As Long, j As Long
 
 Set sh = ActiveSheet 'use here the necessary sheet
 lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row of A:A column
 lastCol = Split(sh.cells(1, sh.Columns.count).End(xlToLeft).Address, "$")(1) 'extract the last column Letter
 chartName = "MyChartSorted"
 
 Set dict = CreateObject("Scripting.Dictionary") 'create the necessary dictionary object
 For i = 2 To lastR
    dict.Add i - 1, sh.Range("A" & i & ":" & lastCol & i).value 'place in the dictionary the ranges to become chart series
 Next i
 
 arrN = sh.Range("A1:" & lastCol & 1).value    'X axes values (names array)
 
 'Create the reference array of summarized values per column:
 ReDim arrSort(1 To UBound(arrN, 2))
 
 For i = 1 To UBound(arrN, 2)
      For j = 1 To dict.count
            arrSort(i) = arrSort(i)   dict(j)(1, i) 'add each column value to summarize
      Next j
 Next i

 '_______________________________________________
 'Debug.Print Join(arrSort, "|"): Stop
 sortDArrs arrSort, arrN, dict  'sort the involved arrays (ranges) according to arrSort sorted descending

 'if the (testing) chart exists, delete it:
 On Error Resume Next
   ActiveSheet.ChartObjects(chartName).Delete
 On Error GoTo 0
 
 'create the necessary chart:
 With ActiveSheet.ChartObjects.Add(left:=100, width:=375, top:=80, height:=225).Chart
    .Parent.Name = chartName                         'name it to have a reference when delete it
    
    For i = 1 To dict.count 'add a new series from the dictionary (sorted) items:
        .SeriesCollection.NewSeries.Values = dict(i) 'add the series
    Next i
    
    .HasTitle = True                        'set it to allow a Title
    .chartTitle.text = "My Sorted Chart"    'set the Title
    .ChartType = xlColumnStacked            'set the chart type
    .SeriesCollection(1).XValues = arrN     'add values to X axis
 End With
End Sub

Sub sortDArrs(arrS, arrN, dict As Object)  'sort descending all involved arrays/ranges
    Dim i As Long, nxtEl As Long, tmp, tmpN, arrTemp, arrT, k As Long, j As Long
    ReDim arrTemp(dict.count - 1): ReDim arrT(1 To 1, 1 To UBound(arrN, 2))

   For i = LBound(arrS) To UBound(arrS) - 1 'iterate between the arrS elements (except the last):
        For nxtEl = i   1 To UBound(arrS)   'iterate between the arrS elements (starting from the second one):
            If arrS(i) < arrS(nxtEl) Then   'sort the arrays according to the element values (< means descending)
                tmp = arrS(i): tmpN = arrN(1, i) 'memorize the element temporaty walue
                For k = 0 To UBound(arrTemp): arrTemp(k) = dict(k   1)(1, i): Next k 'do the same for each dictionary item
                arrS(i) = arrS(nxtEl): arrN(1, i) = arrN(1, nxtEl)
                For k = 1 To dict.count - 1      'the arrays content of a dictionary item cannot be changed directly!!!
                    arrT = dict(k): arrT(1, i) = dict(k)(1, nxtEl): dict(k) = arrT 'it cam be changed in this way
                Next k
                arrS(nxtEl) = tmp: arrN(1, nxtEl) = tmpN 'switch the array element value to the memorized one
                For k = 1 To dict.count          'do the same in each dictionary item array:
                    arrT = dict(k): arrT(1, nxtEl) = arrTemp(k - 1): dict(k) = arrT
                Next k
            End If
        Next nxtEl
    Next i
End Sub

The sheet Change event should have the necessary manually adapted. It can be automatically determined, but, in order to avoid running the code for each added header or value on the last row, a special cell should be also targeted and the event to skip the Sub running when the new range is added. Let us say the word "STOP". When deleted, everything should work as it should (automatically calculating the lastR and LastCol similarly as in the above code).