CODEWITHSUNDEEP
excelvbalabel
user3632580
user3632580

Reputation: 21

Excel VBA chart, show data label on last point only

I want to add data labels to only the final point on my line graph, at the moment I am using the below, which works fine but only if I know what number the final point is. I've done a lot of searching and found the points(points.count) object in excel help but I can't seem to make it work for me. Please can you suggest a way of only showing the last point on my chart or (ideally) all charts on a worksheet.

Sub Data_Labels()
'
' Data_Labels Macro

    ActiveSheet.ChartObjects("Menck Chart").Activate
    ActiveChart.SeriesCollection(1).DataLabels.Select
    Selection.Delete
    ActiveSheet.ChartObjects("Menck Chart").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Points(59).Select
    ActiveChart.SeriesCollection(1).Points(59).ApplyDataLabels
    ActiveChart.SeriesCollection(1).DataLabels.Select
    Selection.Format.TextFrame2.TextRange.Font.Size = 9


End Sub

Upvotes: 2

Views: 16674

Answers (3)

was
was

Reputation: 353

Yet another way in VBA (e.g. paste as a new hotkey macro in PERSONAL workbook): https://peltiertech.com/Excel/Charts/LabelLastPoint.html

For impatient, with ShowValue:=True:

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:=True, _
                AutoText:=True, LegendKey:=False
            bLabeled = (Err.Number = 0)
            On Error GoTo 0
          End If
        Next
      End With
    Next
  End If
End Sub

Upvotes: 0

CodeJockey
CodeJockey

Reputation: 1981

Short Answer

 Dim NumPoints as Long
 NumPoints = ActiveChart.SeriesCollection(1).Count
 ActiveChart.SeriesCollection(1).Points(NumPoints).ApplyDataLabels

Long Answer

The use of ActiveChart is vague, and requires the additional step of selecting the chart of interest. If you specify the chart you are interested in explicitly, your macro will be much more robust and easier to read. I also recommend either using a With block, or creating intermediate variables, since reading ActiveChart.SeriesCollection(1).Points over and over is painful and clutters your code. Try the later method as follows:

 Dim chartMenck As Chart, menckPoints as Points, menckDataLabel as DataLabel
 Set chartMenck = Sheet1.ChartObjects("Menck Chart").Chart 
 Set menckPoints  = chartMenck SeriesCollection(1).Points
 menckPoints(menckPoints.Count).ApplyDataLabels
 Set menckDataLabel = menckPoints(menckPoints.Count).DataLabel
 menckDataLabel.Font.Size = 9

This is nearly half as long as the original and far easier to read, in my opinion.

Upvotes: 4

David Zemens
David Zemens

Reputation: 53623

Try this. First it applies datalabels to ALL points, and then removes them from each point except the last one.

I use the Points.Count - 1 that way the For/Next loop stops before the last point.

Sub Data_Labels()
'
Data_Labels Macro
Dim ws As Worksheet
Dim cht as Chart
Dim srs as Series
Dim pt as Point
Dim p as Integer
Set ws = ActiveSheet
Set cht = ws.ChartObjects("Menck Chart")
Set srs = cht.SeriesCollection(1)
    '## Turn on the data labels
    srs.ApplyDataLabels
    '## Iterate the points in this series
    For p = 1 to srs.Points.Count - 1 
        Set pt = srs.Points(p)
        '## remove the datalabel for this point
        p.Datalabel.Text = ""
    Next
    '## Format the last datalabel to font.size = 9
    srs.Points(srs.Points.Count).DataLabel.Format.TextFrame2.TextRange.Font.Size = 9


End Sub

Upvotes: 2

Related Questions