Search code examples
excelvbaexcel-charts

Sort Chart In Descending Order


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

enter image description here

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 :

enter image description here


Solution

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