Excel - (Column) chart - Z-index of data series according to actual value

Question

I have a column chart with multiple data series. For example:

I don't want to have columns next to each other so I set reduced Series overlap and Gap width in Format Data Series...

Now the Series are one over the other. But their Z-index (Z-position) is defined by the Series order in the chart, so when the last Series has highest value, its column outgroves the others which are not visible.

Is somehow possible to order the columns according their actual value? I'd like to bring the smallest value most front. Like in this image (ancient mspaint-fu used here :) ).

(//edited - the first version was wrongly mspainted)

PS: I need it for really big data series (it looks like histograms), so I definitely don't want to put the columns next to each other. But it could be "filtered" to low series view where using of other chart type could cause distortion of displaying these discreet values.

Thanks for your suggestions!

Answer 1

One way is to create a processing table that works out the ascending order of the series.

Columns E:G work out the 1st smallest, 2nd smallest and so on using the SMALL() formula, where the first parameter is your row of values, and the second the rank - so cell E3 is =SMALL($A3:$C3,1), F3 =SMALL($A3:$C3,2) and G3 =SMALL($A3:$C3,3). Copy down as many rows as you have, and add as many columns as you need if it's more than 3 series.

Then we need a processing table, shown in columns J:R.

A column for each series is present, for every possible position in ascending order. In the "1st" column group, in column J we can check whether series A is the 1st smallest series using the formula

`=IF(E3=A3,A3,0)`

If there is a match, the value for the series is shown. If not, zero is shown.

Now if you create your clustered column chart using range J2:R6 and apply 100% series overlap, you'll see you need to reorder the columns. Using the Select Data dialog box, reorder the columns so 3C is at the top and 1A at the bottom.

Finally, change the colours of each series. All A series must be blue, all B series must be orange and C all grey (or whatever your actual colours are).

Answer 2

I created macro for Andi Mohr's solution automation. Maybe someone find it useful.

Features/limitations:

• Works with vertical column charts
• Creates "helping" table with column for all partial series needed.
• Expects data series in columns
• Disabled items series (in "Select data source") could break the macro!
• The "helping" table could be moved to another sheet
• Interactivity with the original table is kept
• Column color (fill) is copied from the source Chart

Usage

1. Copy code into VBA module
2. Select the source table
3. Run the macro

GIF

Code

Option Explicit

Public Sub Chart_ZIndexAdjusted()
    Dim SourceChart As Chart
    Set SourceChart = ActiveChart
    
    If SourceChart Is Nothing Then
        Call MsgBox("No chart selected." & vbNewLine & "(Do not select chart Axis!)", vbOKOnly + vbExclamation, "Error")
        Exit Sub
    End If
    
    'Check Chart type
    Select Case SourceChart.ChartType
    Case xlColumnClustered 'comma separated values
        Debug.Print "ChartType OK"
    Case Else
        Call MsgBox("ChartType: " & CStr(SourceChart.ChartType) & " is not supported." & vbNewLine & vbNewLine & "More about ChartTypes: https://docs.microsoft.com/en-us/office/vba/api/excel.xlcharttype", vbOKOnly + vbExclamation, "Error")
        Exit Sub
    End Select
    
    Dim SeriesCol As SeriesCollection
    Set SeriesCol = SourceChart.SeriesCollection 'All series from the chart
    
    Dim ValRng() As Range
    ReDim ValRng(1 To SeriesCol.Count) 'Range arrays for each series
    
    Dim NameRng() As Range
    ReDim NameRng(1 To SeriesCol.Count) 'Range with name for each series
    
    Dim CategoriesVal As String 'Value specifying categories
    
    Dim SeriesCount As Long
    SeriesCount = SeriesCol.Count
    
    'Ranges addresses could be retrieved for each series from its Formula property
    Dim i As Long
    For i = 1 To SeriesCount
        Dim FormulaParts() As String
        FormulaParts = Split(SeriesCol(i).Formula, ",")

        Set NameRng(i) = Range(Mid(FormulaParts(0), Len("=SERIES(") + 1, Len(FormulaParts(0)) - Len("=SERIES(")))
        Set ValRng(i) = Range(FormulaParts(2))
        If i = 1 Then
                CategoriesVal = FormulaParts(1)
        End If
    Next i
    
    'Check if all data are in one "table" and sheet
    Dim ValuesStartRow As Long
    Dim ValuesLength As Long
    Dim Sheet As Worksheet
    ValuesStartRow = ValRng(1).Cells.Item(1).Row
    ValuesLength = ValRng(1).Cells.Rows.Count
    Set Sheet = ValRng(1).Parent
    For i = 2 To SeriesCol.Count
        If Not ((ValuesStartRow = ValRng(i).Cells.Item(1).Row) _
                And (ValuesLength = ValRng(i).Cells.Rows.Count) _
                And (Sheet Is ValRng(i).Parent)) _
        Then
            Call MsgBox("Chart values are not on same sheet or lines or series does not have same length", vbOKOnly + vbExclamation, "Error")
            Exit Sub
        End If
    Next i
    
    Dim NTName As String 'Name for a new table for chart
    NTName = SourceChart.Name & "_InputData"
    
    'Look for old table and remove it
    With Sheet.ListObjects
        For i = 1 To .Count
            If .Item(i).Name = NTName Then
                .Item(i).Delete
            End If
        Next i
    End With
    
    'check if there is space for table headers
    If ValuesStartRow < 2 Then
        Call MsgBox("No space for a new table headers" & vbNewLine & "(Add a row on top of the sheet and try it again.)", vbOKOnly + vbExclamation, "Error")
    End If
    
    Dim NTRange As Range 'New Table Range
    Set NTRange = Sheet.Cells(ValuesStartRow - 1, Sheet.UsedRange.Columns.Count + 3) 'Placed two cells right from most right cell in the sheet
    
    Dim NTCols As Long
    NTCols = SeriesCount * SeriesCount 'Count of columns needed is series count ^2
    
    Set NTRange = NTRange.Resize(ValuesLength, NTCols)
    'NTRange.Select
 
    Dim NT As ListObject 'A new table for a new chart
    Set NT = Sheet.ListObjects.Add(xlSrcRange, NTRange)
    NT.Name = SourceChart.Name & "_InputData"
    NT.Range.Select 'Select a new table (it scrolls to its position)
    
    'Populate a new table headers
    Dim j As Long
    With NT.HeaderRowRange.Cells
        For i = 1 To SeriesCount
            For j = 1 To SeriesCount
                .Item((i - 1) * SeriesCount + j).Value2 = NameRng(j).Value2 & CStr(i)
            Next j
        Next i
    End With
    
    'Populate New Table with
    With NT.ListColumns
        For i = 1 To SeriesCount 'i is Z-index of column of the New Table
            Dim AllValsArray As String 'Array of addresses of all first series values
            AllValsArray = ValRng(1).Item(1).Address(False, False) 'The initial (1st) value (without delimiter)
            For j = 2 To SeriesCount
                AllValsArray = AllValsArray & "," & ValRng(j).Item(1).Address(False, False) 'delimiter + added value
            Next j
            
            Dim FormulaText As String
            For j = 1 To SeriesCount
                Dim ValueCellAddr As String 'Address of first cell with series values
                ValueCellAddr = ValRng(j).Item(1).Address(False, False)
                'Set text of formula
                FormulaText = "=IF(RANK.EQ(" & ValueCellAddr & ",(" & AllValsArray & "),0)=" & i & "," & ValueCellAddr & ",0)"
                'Insert formula to the first cell of the column
                .Item((i - 1) * SeriesCount + j).DataBodyRange.Formula = FormulaText
            Next j
        Next i
    End With
    
    Dim ChObj As ChartObject 'Chartobject for selected chart
    For Each ChObj In Sheet.ChartObjects
        If ChObj.Chart Is SourceChart Then
            Exit For
        End If
    Next ChObj
    
    Dim NTChName As String 'Name for a new chart
    NTChName = ChObj.Name & "_ZindexAdjusted"
    
    'Find and delete existing Z-index Adjusted chart
    With Sheet.ChartObjects
        For i = 1 To .Count
            If .Item(i).Name = NTChName Then
                Call .Item(i).Delete
            End If
        Next i
    End With

    Dim NTChObj As Object 'Must be Object Type! See: https://docs.microsoft.com/en-us/office/vba/api/excel.worksheet.chartobjects#return-value
    Set NTChObj = ChObj.Duplicate 'Create copy of the chart
    NTChObj.Name = NTChName 'Rename a new chart
    
    Dim FillColor() As Long
    ReDim FillColor(1 To SeriesCount)
    Dim LineColor() As Long
    ReDim LineColor(1 To SeriesCount)
    
    With SourceChart.SeriesCollection
        For i = 1 To SeriesCount
            'Saves color from the original chart
            FillColor(i) = SourceChart.SeriesCollection.Item(i).Format.Fill.ForeColor.RGB
            'LineColor(i) = SourceChart.SeriesCollection.Item(i).Format.Line.Forecolor.RGB
        Next i
    End With

    'Remove all series in copied chart
    With NTChObj.Chart.SeriesCollection
        For i = 1 To .Count
            .Item(1).Delete 'Item(1) because collection is re-numbered during loop
        Next i
        
        'Create a new series from the new table
        For i = 1 To NTCols
            Call .Add(NT.ListColumns.Item(i).Range, xlColumns, True, False) 'Add a new series
            With .Item(.Count).Format 'the last added series
                'Set series colors (only the fill acc. to orginal chart)
                .Fill.ForeColor.RGB = FillColor(i - (Fix((i - 1) / SeriesCount) * SeriesCount)) 'fix = trunc
                '.Line.Forecolor.RGB = FillColor(i - (Fix((i - 1) / SeriesCount) * SeriesCount))
            End With
        Next i
    End With
    
    'Set copy catergories labels
    If Len(CategoriesVal) > 0 Then
        NTChObj.Chart.FullSeriesCollection(1).XValues = "=" & CategoriesVal
    End If
    
'Lines bellow could be uncommented if you want features described in comments
'============================================================================

'    'Delete the original chart (not recommended)
'    Call ChObj.Delete

'    'Place the new chart over the original (original will be hidden under)
'    NTChObj.Left = ChObj.Left
'    NTChObj.Top = ChObj.Top

End Sub