In Stack Columns In Order Of Size I showed a worksheet formula approach to sort columns in each stack in a stacked chart by size, not by series. When you create a stacked column chart the usual way, the columns are stacked in the same series order, as shown below.
– – –
This technique required seven columns of intricate calculations to portray the three series, the columns of formulas increase faster than the number of visible series in the chart, and the formulas become longer as series are added. Too much tedium, too many chances to mess it up.
So I build a simple VBA routine. A1:D14 is the input data (the data need not start in A1). The first row contains series names and the cells are filled with the color to format the data points in the chart. The first column holds the category labels, and the data to be sorted and plotted is in B2:D14.
F1:L14 is the output data. The category labels and series names are copied over from the input range. (The bottom series in the chart is labeled with the first series name, regardless of which column of the original data provides the points for this series.) Each row of data values has been sorted left to right in decreasing order in G2:I14, and the series name corresponding to a particular data value is placed in the same cell within the range J1:L14.
Here is the chart created by the program.
This procedure works just as well if there are four or more initially columns of data, unlike the manual worksheet formula version, which is already getting bogged down at three columns.
Frankly, I’m not sure the charts with sorted columns are easier to read. In fact, when they are sorted it’s easier to keep track of which value goes with which series. With the blocks in different order for each stack, you have to keep referring to the legend. This negates any possible benefit of the blocks being in numerical order.
The VBA code is shown below. The procedure ProcessInputRange does all the work in the range passed to it. The procedure ProcessInputRangeSelection is run from Excel: it finds the selected range and passes it to ProcessInputRange. I separate my code into pieces like this to make it easier to reuse the pieces. For example, I could call ProcessInputRange from a different routine, perhaps cycling through all the sheets in a workbook and processing all of the data.
Sub ProcessInputRangeSelection() If TypeName(Selection) = "Range" Then ProcessInputRange Selection End If ActiveSheet.Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Select End Sub Sub ProcessInputRange(rInput As Range) ' range- and array-related Dim vaInput As Variant Dim vaYValues As Variant Dim vaXValues As Variant Dim vaNames As Variant Dim vaLabels As Variant Dim vYValueTemp As Variant Dim vLabelTemp As Variant Dim nXValues As Long Dim nNames As Long Dim iRow As Long Dim iCol As Long Dim iCol1 As Long Dim iCol2 As Long Dim rOutput As Range ' chart-related Dim lLeft As Double Dim lTop As Double Dim lWidth As Double Dim lHeight As Double Dim cht As Chart Dim iSeries As Long Dim iPoint As Long Dim vaColor As Variant vaInput = rInput.Value2 nXValues = UBound(vaInput, 1) - 1 nNames = UBound(vaInput, 2) - 1 ReDim vaNames(1 To 1, 1 To nNames) ReDim vaXValues(1 To nXValues, 1 To 1) ReDim vaYValues(1 To nXValues, 1 To nNames) ReDim vaLabels(1 To nXValues, 1 To nNames) ' populate arrays For iRow = 1 To nXValues vaXValues(iRow, 1) = vaInput(iRow + 1, 1) Next For iCol = 1 To nNames vaNames(1, iCol) = vaInput(1, iCol + 1) Next For iRow = 1 To nXValues For iCol = 1 To nNames vaYValues(iRow, iCol) = vaInput(iRow + 1, iCol + 1) vaLabels(iRow, iCol) = vaNames(1, iCol) Next Next ' bubble sort values in each row, sort labels at same time For iRow = 1 To nXValues For iCol1 = 1 To nNames - 1 For iCol2 = iCol1 + 1 To nNames If vaYValues(iRow, iCol2) > vaYValues(iRow, iCol1) Then vYValueTemp = vaYValues(iRow, iCol1) vaYValues(iRow, iCol1) = vaYValues(iRow, iCol2) vaYValues(iRow, iCol2) = vYValueTemp vLabelTemp = vaLabels(iRow, iCol1) vaLabels(iRow, iCol1) = vaLabels(iRow, iCol2) vaLabels(iRow, iCol2) = vLabelTemp End If Next Next Next ' put adjusted arrays into worksheet Set rOutput = rInput.Resize(1, 1).Offset(, nNames + 2) rOutput.Offset(, 1).Resize(, nNames).Value = vaNames rOutput.Offset(1).Resize(nXValues).Value = vaXValues rOutput.Offset(1, 1).Resize(nXValues, nNames).Value = vaYValues rOutput.Offset(1, 1 + nNames).Resize(nXValues, nNames).Value = vaLabels ' get colors With rInput.Offset(, 1).Resize(1, nNames) ReDim vaColor(1 To 1, 1 To nNames) For iCol = 1 To nNames vaColor(1, iCol) = .Cells(1, iCol).Interior.ColorIndex Next End With ' process chart lWidth = ActiveWindow.UsableWidth / 2 lHeight = ActiveWindow.UsableHeight / 2 lLeft = ActiveSheet.Columns(ActiveWindow.ScrollColumn).Left + lWidth / 2 lTop = ActiveSheet.Rows(ActiveWindow.ScrollRow).Top + lHeight / 2 Set cht = ActiveSheet.ChartObjects.Add(lLeft, lTop, lWidth, lHeight).Chart With cht .SetSourceData Source:=rOutput.Resize(nXValues + 1, nNames + 1), PlotBy:=xlColumns .ChartType = xlColumnStacked .ChartGroups(1).GapWidth = 100 With .PlotArea .Border.LineStyle = xlNone .Interior.ColorIndex = xlNone End With With .Axes(xlValue) .Border.LineStyle = xlNone With .MajorGridlines.Border .ColorIndex = 48 .Weight = xlThin End With End With .Legend.Border.LineStyle = xlNone With .ChartArea .Border.LineStyle = xlNone .AutoScaleFont = False .Font.Size = 9 End With ' format points For iSeries = 1 To nNames With .SeriesCollection(iSeries) .Border.LineStyle = xlNone .Interior.ColorIndex = vaColor(1, iSeries) For iPoint = 1 To nXValues For iCol = 1 To nNames If vaLabels(iPoint, iSeries) = vaNames(1, iCol) Then .Points(iPoint).Interior.ColorIndex = vaColor(1, iCol) Exit For End If Next Next End With Next End With End Sub
To use the program, select your input data range, press Alt+F8 to bring up the Macro dialog, select ProcessInputRangeSelection, and press Run.