Search code examples
excelvbalabeling

Datalabel for XY chart in Excel VBA from non-contigous rows

I want to label a xy plot using non-contiguous rows into one chart from separate serie collections which is one red and another one blue as on the image below.enter image description here

There is an error the code below:

Sub AddDataLabels3()
Dim curLabel As Integer: curLabel = 1
Dim rwCount As Integer
Dim rngArea As Range

'Enable error handling
On Error Resume Next
 
'Display an inputbox and ask the user for a cell range
Set Rng1 = Application.InputBox(prompt:="Select cells to link" _
    , Title:="Select data label values", Default:=ActiveCell.Address, Type:=8)
Set Rng2 = Application.InputBox(prompt:="Select cells to link" _
    , Title:="Select data label values", Default:=ActiveCell.Address, Type:=8)
Set Rng = Union(Rng1, Rng2)
'Disable error handling
On Error GoTo 0
'Rng.Count = 1
With ActiveChart
    If Rng.Areas.Count > 1 Then
    'Debug.Print "It's a non-contiguous range"
    For Each rngArea In Rng.Areas
        rwCount = rwCount + rngArea.Rows.Count
    Next
    End If
    'Iterate through each series in chart
    For Each ChSer In .SeriesCollection

        'Save chart point to object SerPo
        Set SerPo = ChSer.Points

        'Save the number of points in chart to variable j
        j = SerPo.Count

        'Iterate though each point in current series
        For i = 1 To j

            'Enable data label for current chart point
            SerPo(i).ApplyDataLabels Type:=xlShowValue

            'Save cell reference to chart point
            SerPo(i).DataLabel.FormulaLocal = Rng.Areas(rwCount).Cells(curLabel).FormulaLocal
            '& rng.Cells(i).Reference(ReferenceStyle:=xlR1C1)
            
            ' Next label
            curLabel = curLabel + 1
            'Rng.Count = Rng.Count + 1
            
        Next
    Next
End With
End Sub

The error is on the line:

SerPo(i).DataLabel.FormulaLocal = Rng.Areas(rwCount).Cells(curLabel).FormulaLocal

How to solve this problem, could you please help me?

Solution

  • Your getting the two datalabels ranges with rng1 and rng2. I used rng to be rng1 or rng2 depending on PlotOrder property, which is the order the series are shown in the "Select Data Source".

    NOTE: It's always a good practice to use the Option Explict

    Option Explicit

Sub AddDataLabels3()
    Dim rng As Range, rng1 As Range, rng2 As Range
    Dim ChSer As Series
    Dim SerPo As Object
    Dim i As Byte, j As Byte
    
    'Enable error handling
    On Error Resume Next
     
    'Display an inputbox and ask the user for a cell range
    Set rng1 = Application.InputBox(prompt:="Select cells to link" _
        , Title:="Select data label values", Default:=ActiveCell.Address, Type:=8)  ' Series1 -> PlotOrder = 1
        
    Set rng2 = Application.InputBox(prompt:="Select cells to link" _
        , Title:="Select data label values", Default:=ActiveCell.Address, Type:=8)  ' Series2 -> PlotOrder = 2
    
    'Disable error handling
    On Error GoTo 0
    
    With ActiveChart
        'Iterate through each series in chart
        For Each ChSer In .SeriesCollection
            If ChSer.PlotOrder = 1 Then
                Set rng = rng1
            Else
                Set rng = rng2
            End If
    
            'Save chart point to object SerPo
            Set SerPo = ChSer.Points
    
            'Save the number of points in chart to variable j
            j = SerPo.Count
    
            'Iterate though each point in current series
            For i = 1 To j
    
                'Enable data label for current chart point
                SerPo(i).ApplyDataLabels Type:=xlShowValue
    
                'Save cell reference to chart point
                SerPo(i).DataLabel.FormulaLocal = rng.Cells(i).FormulaLocal
            Next
        Next
    End With
End Sub