I made this chart in Excel 2003:
I used this data:
| Vehicle | 1/31/2012 | 2/29/2012 | 3/31/2012 | 4/30/2012 | 5/31/2012 | 6/30/2012 | 7/31/2012 | 8/31/2012 | 9/30/2012 |
| Cars | 603 | 615 | 627 | 634 | 646 | 659 | 672 | 679 | 693 |
| Trucks | 405 | 413 | 433 | 442 | 451 | 440 | 430 | 445 | 475 |
| Vans | 545 | 556 | 567 | 578 | 590 | 602 | 590 | 585 | 580 |
| SUVs | 465 | 512 | 527 | 570 | 604 | 634 | 672 | 726 | 750 |
| Hybrids | 510 | 519 | 571 | 628 | 672 | 725 | 775 | 805 | 855 |
Normally I would put the series name at the end of the line (because I like how it looks), but I wanted to include the starting and ending values too. So I decided to put the series name on the second to last data point. If all the labels are at the top or bottom, it looks terrible because they run into other lines. I needed to put the label above or below the line based on how much space was available. That was harder than I thought it would be.
I ended up looping through the collection a lot: once to store the values at position 8, another couple times to sort, and yet another time to apply the labels. I started with some of Peltier’s code and modified for my needs.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 |
Public Sub LabelInventoryChart() Dim cht As Chart Dim srsType As Series Dim aPoints() As Double Dim i As Long, j As Long Dim lTempSrs As Long, dTempVal As Long Const lLBLOFFSET As Long = 7 'how far away the label is from the line Const lPNTOFFSET As Long = 1 'which data point to put the series name on (from right) 'Get the chart and dim an array to hold the values at the 'data point Set cht = wshInventory.ChartObjects(1).Chart ReDim aPoints(1 To cht.SeriesCollection.Count, 1 To 2) 'Loop through the series and fill an array with the data point 'values For Each srsType In cht.SeriesCollection With srsType If .Points.Count > lPNTOFFSET Then aPoints(srsType.PlotOrder, 1) = srsType.PlotOrder aPoints(srsType.PlotOrder, 2) = srsType.Values(.Points.Count - lPNTOFFSET) End If End With Next srsType 'Sort the array on the values - descending For i = LBound(aPoints, 1) To UBound(aPoints, 1) - 1 For j = i To UBound(aPoints, 1) If aPoints(i, 2) < aPoints(j, 2) Then lTempSrs = aPoints(i, 1) dTempVal = aPoints(i, 2) aPoints(i, 1) = aPoints(j, 1) aPoints(i, 2) = aPoints(j, 2) aPoints(j, 1) = lTempSrs aPoints(j, 2) = dTempVal End If Next j Next i 'Loop through the series and show data labels For i = LBound(aPoints, 1) To UBound(aPoints, 1) Set srsType = cht.SeriesCollection.Item(aPoints(i, 1)) With srsType If .Points.Count > lPNTOFFSET Then With .Points(.Points.Count - lPNTOFFSET) 'Create a value label, change the text to the series name, and 'change the color to match the line .ApplyDataLabels xlDataLabelsShowValue, False, True .DataLabel.Text = srsType.Name .DataLabel.Font.Color = srsType.Border.Color 'The data label for the top line goes on top If i = LBound(aPoints, 1) Then .DataLabel.Position = xlLabelPositionAbove .DataLabel.Top = .DataLabel.Top + lLBLOFFSET 'The data label for the lowest line goes on the bottom ElseIf i = UBound(aPoints, 1) Then .DataLabel.Position = xlLabelPositionBelow .DataLabel.Top = .DataLabel.Top - lLBLOFFSET Else 'Figure out if above or below has more space and put the 'data label where there's the most room If Abs(aPoints(i, 2) - aPoints(i - 1, 2)) < Abs(aPoints(i, 2) - aPoints(i + 1, 2)) Then .DataLabel.Position = xlLabelPositionBelow .DataLabel.Top = .DataLabel.Top - lLBLOFFSET Else .DataLabel.Position = xlLabelPositionAbove .DataLabel.Top = .DataLabel.Top + lLBLOFFSET End If End If End With End If 'Show data labels for starting and ending data With .Points(1) .ApplyDataLabels xlDataLabelsShowValue, False, True .DataLabel.Position = xlLabelPositionLeft .DataLabel.Font.Color = srsType.Border.Color End With With .Points(.Points.Count) .ApplyDataLabels xlDataLabelsShowValue, False, True .DataLabel.Position = xlLabelPositionRight .DataLabel.Font.Color = srsType.Border.Color End With End With Next i End Sub |
The lines diverge toward the end, so using the 8th data point turned out good. If they converged, it wouldn’t really matter whether there was more space on the top or bottom, they would still run into each other. In that case I would change lPNTOFFSET to a more appropriate place.
Very slick and useful.
Why not have the last data label show both name and value?
Hey, that’s not too bad
I think I prefer it the other way, visually, but at about 1/3 of the code and no chance of bumping into each other, the trade-off is probably worth it.
What if the last values of multiple series are the same or too close to each other?
I like a design often used in WSJ charts where series labels (or labels+values) in the legend are ordered by last values rankage and colored according to the series colors.
Charley Kyd suggested one of the ways to do it in Excel with custom legend and without VBA.
Dick – why not have an option for the name and value placement ?
Leonid makes a great point: you can’t assume the last data points are going to show a nice separation.
Hey guys, not very experienced with VBA here. I am getting a Run-Time error ‘424’ on the following line
Set cht = wshInventory.ChartObjects(1).Chart
I am using excel 2003.
I replaced that line with
Set cht = ActiveSheet.ChartObjects(1).Chart
and it worked, thanks again for this post. very sleek
One last question, is there a property on the .datalabel where I can force the data label to be on one line (as opposed to wrapping into multiple lines).
@macutan,
Prior to xl2013 data labels have no Width or Height property you can alter, either manually or with code.
So no you can not force single line text.
The only alternative is to use textbox shapes.