CODEWITHSUNDEEP
excelvba
Zacchini
Zacchini

Reputation: 143

Finding and highlighting the last data point in a series/column VBA

I have a macro for creating a graph and part of it identifies and highlights the final data point like below:

enter image description here

This works all well and good when there's data in the final row of a column, but in some cases the final row is empty therefore no point is highlighted like so:

enter image description here

I was wondering if there was a way to make it highlight the last point that has actual data, so even though the last row may be empty, it highlights the last row with data.

Could the following be incorporated into my code? it finds the last data point in column B:

Dim lRow As Long

lRow = Cells(Rows.Count, 2).End(xlUp).Row

Here is my code:

    With co.Chart
        .FullSeriesCollection(1).ChartType = xlXYScatter
        .FullSeriesCollection(1).AxisGroup = 1
        .FullSeriesCollection(2).ChartType = xlLine
        .FullSeriesCollection(2).AxisGroup = 1
        .SetSourceData Source:=my_range
        .Axes(xlCategory).TickLabels.NumberFormat = "m/yy"
        'highlight final dot of data
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count).ApplyDataLabels Type:=xlShowValue
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count).MarkerSize = 7
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count).MarkerStyle = xlCircle
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count).MarkerBackgroundColorIndex = 6
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count).MarkerForegroundColorIndex = 1
        .HasTitle = True
        .ChartTitle.Text = t
        ResolveSeriesnames co.Chart
        .Location Where:=xlLocationAsObject, Name:="Graphs"

Upvotes: 1

Views: 802

Answers (1)

Zacchini
Zacchini

Reputation: 143

I found this code on https://peltiertech.com/label-last-point-for-excel-2007/ and made a couple adjustments which works 

Sub LastPointLabel2()
  Dim srs As Series
  Dim iPts As Long
  Dim cht As ChartObject
  Dim vYVals As Variant
  Dim vXVals As Variant
  Set ws = ActiveSheet

  If ActiveChart Is Nothing Then
    MsgBox "Select a chart and try again.", vbExclamation
  Else
    Application.ScreenUpdating = False
  For Each cht In ws.ChartObjects
      Set srs = cht.Chart.SeriesCollection(1)
      With srs
        vYVals = .Values
        'vXVals = .XValues
        ' clear existing labels
        .HasDataLabels = False
        For iPts = .Points.Count To 1 Step -1
          If Not IsEmpty(vYVals(iPts)) Then
            ' add label
            srs.Points(iPts).ApplyDataLabels _
                ShowSeriesName:=False, _
                ShowCategoryName:=False, ShowValue:=True, _
                AutoText:=True, LegendKey:=False
            Exit For
          End If
        Next
      End With
    Next
    ' legend is now unnecessary
    Application.ScreenUpdating = True
  End If
End Sub

Upvotes: 1

Related Questions