Sort Chart In Descending Order - excel

Question

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 :

Answer 1

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