Peltier Technical Services, Inc.
 

Excel Chart Add-Ins | Training | Charts and Tutorials | Peltier Tech Blog


Peltier Tech Chart Utility

 

Excel Dashboards

 

Books at Amazon.com

 

Label the Last Point in an Excel Chart's Series.


 

This simple VBA procedure labels each series in a chart with the name of the series. In some cases this may be more useful than using the legend. This procedure can easily be modified, for example, to label the maximum or minimum point in a series, using any label that is needed.

Highlights of the Code

The procedure loops through all the series in the active chart:

For Each [Series] In ActiveChart.SeriesCollection
  ...
Next

It determines the number of points in each series:

nPts = [Series].Points.Count

It applies a data label to the last point in the series:

[Series].Points(nPts).ApplyDataLabels _
    Type:=xlDataLabelsShowValue, _
    AutoText:=True, _
    LegendKey:=False

And it changes the data label to the name (legend entry) of the series:

[Series].Points(nPts).DataLabel.Text = [Series].Name
Implementation

The code below represents a regular code module in an Excel VBA project. LastPointLabel is the procedure which applies a label to the last point in each series, and changes the text of the label to the name of the series.

Copy the code below, and paste it into a new module. Make sure the Option Explicit line appears only once. LabelLastPoint.zip is a zip file containing this procedure and a floating command bar with a Label Last Point button to make it work.


    Option Explicit

    Sub LastPointLabel()
      Dim mySrs As Series
      Dim nPts As Long
      For Each mySrs In ActiveChart.SeriesCollection
      With mySrs
        nPts = .Points.Count
        mySrs.Points(nPts).ApplyDataLabels _
            Type:=xlDataLabelsShowValue, _
            AutoText:=True, LegendKey:=False
        mySrs.Points(nPts).DataLabel.Text = mySrs.Name
      End With
      Next
    End Sub

A chart must be selected before this code is run, otherwise an error will occur on this line:

  For Each mySrs In ActiveChart.SeriesCollection

A small amount of error prevention can be included which checks for an active chart, and prompts the user to select one if necessary.


    Option Explicit

    Sub LastPointLabel()
      Dim mySrs As Series
      Dim nPts As Long
      If ActiveChart Is Nothing Then
        MsgBox "Please select a chart and try again.", vbExclamation
      Else
        For Each mySrs In ActiveChart.SeriesCollection
          With mySrs
            nPts = .Points.Count
            mySrs.Points(nPts).ApplyDataLabels _
                Type:=xlDataLabelsShowValue, _
                AutoText:=True, LegendKey:=False
            mySrs.Points(nPts).DataLabel.Text = mySrs.Name
          End With
        Next
      End If
    End Sub

Finally, if a point is not plotted because the corresponding cell is blank or contains the #N/A error, the ApplyDataLabels command will cause an error. The following labels the last point that can be labeled, and reemoves labels from all other points.


    Option Explicit

    Sub LastPointLabel()
      Dim mySrs As Series
      Dim iPts As Long
      Dim bLabeled As Boolean
      If ActiveChart Is Nothing Then
        MsgBox "Select a chart and try again.", vbExclamation, "No Chart Selected"
      Else
        For Each mySrs In ActiveChart.SeriesCollection
          bLabeled = False
          With mySrs
            For iPts = .Points.count To 1 Step -1
              If bLabeled Then
                ' handle error if point isn't plotted
                On Error Resume Next
                ' remove existing label if it's not the last point
                mySrs.Points(iPts).HasDataLabel = False
                On Error GoTo 0
              Else
                ' handle error if point isn't plotted
                On Error Resume Next
                ' add label
                mySrs.Points(iPts).ApplyDataLabels _
                    ShowSeriesName:=True, _
                    ShowCategoryName:=False, ShowValue:=False, _
                    AutoText:=True, LegendKey:=False
                bLabeled = (Err.Number = 0)
                On Error GoTo 0
              End If
            Next
          End With
        Next
      End If
    End Sub

 

Page copy protected against web site content infringement by Copyscape

Peltier Tech Chart Utility

Create Excel dashboards quickly with Plug-N-Play reports.


Peltier Technical Services, Inc.

Excel Chart Add-Ins | Training | Charts and Tutorials | PTS Blog

Peltier Technical Services, Inc., Copyright © 2014. All rights reserved.
You may link to this article or portions of it on your site, but copying is prohibited without permission of Peltier Technical Services.

Microsoft Most Valuable Professional

Microsoft Most Valuable Professional

My MVP Profile