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.
Programmatic Approach
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.
