excelvbalabeling

Datalabel for XY chart in Excel VBA

I need to modify a code on vba which makes the labeling on the XY Plot. I have one code which works well when the sample series are shared on horizontal position. But i have one serie, which is actually consiting of two different series and lies the one after another on the table. Let me show it on the picture, which also shows my target.

enter image description here

The current code i used which doesnt work for my actual case is below:

 'Name macro
Sub AddDataLabels()
 
'Enable error handling
On Error Resume Next
 
'Display an inputbox and ask the user for a cell range
Set Rng = Application.InputBox(prompt:="Select cells to link" _
, Title:="Select data label values", Default:=ActiveCell.Address, Type:=8)
 
'Disable error handling
On Error GoTo 0
 

With ActiveChart
 
'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.Cells(i).FormulaLocal
        '& rng.Cells(i).Reference(ReferenceStyle:=xlR1C1)
    Next
Next
End With
End Sub

If i run this code for the above data series, the chart will result like this:

enter image description here

So how to modify this code in order to get the target chart, please help me on this.

Solution

  • The problem is that in the For loop, the 'i' variable only goes to j, in this case 3. You need a variable to control the labels so that it will go from 1 to 6 (selected range for the labels).

    I created a variable curLabel that is used and incremented in the for loop. Is this what you are looking for?

    Sub AddDataLabels()
    Dim curLabel As Integer: curLabel = 1
    
    'Enable error handling
    On Error Resume Next
     
    'Display an inputbox and ask the user for a cell range
    Set Rng = Application.InputBox(prompt:="Select cells to link" _
        , Title:="Select data label values", Default:=ActiveCell.Address, Type:=8)
        
    'Disable error handling
    On Error GoTo 0

    With ActiveChart
            
        '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.Cells(curLabel).FormulaLocal
                '& rng.Cells(i).Reference(ReferenceStyle:=xlR1C1)
                
                ' Next label
                curLabel = curLabel + 1
            Next
        Next
    End With
End Sub

    You can change the cell values 'Horizontal Series' and 'Vertical Series' and the legend are automatically updated, or you can set the legends elsewhere like the code below.

    Sub AddCustomLegend()
    Dim myLegend As String
    
    ' series 1 legend
    myLegend = "=" & ActiveSheet.Name & "!" & Range("C12").Address
    ActiveChart.SeriesCollection(1).Name = myLegend

    ' series 2 legend
    myLegend = "=" & ActiveSheet.Name & "!" & Range("D12").Address
    ActiveChart.SeriesCollection(2).Name = myLegend
End Sub