Excel Chart: color data labels by categories - rows

Question

This is a follow-up question to this one:

Excel Chart: color data labels by categories - columns

The following code colors the chart data labels according to the categories and values arranged in two rows:

• row 1 = category
• row 2 = value

The routine works fine as long as you have your categories in row 1 and your values in row 2.

How do you make it work with any range of two rows, e.g. rows 5/6 or 27/28?

Cells(categoryColorRow, colIndex) and Cells(valueColorRow, colIndex) always point to rows 1 and 2.

How do you derive colIndexfrom the chart series formula?

Sub Labels_SourceROWS_v2()
   Dim p As Point
   Dim CatValueLength As Variant
   Dim dls As DataLabels
   Dim length As Long
   Dim labelItems As Variant
   Dim categoryColorRow As Long
   Dim valueColorRow As Long
   Dim colIndex As Long
   Dim color As Long
   Dim valueText As String
   Dim percentText As String
   Dim startPos As Long
   categoryColorRow = 1
   valueColorRow = 2
   colIndex = 2
   With ActiveChart.SeriesCollection(1)
       .HasDataLabels = True
       With .DataLabels
           .ShowValue = True
           .ShowCategoryName = True
           .Separator = vbLf
           .Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
           .Format.TextFrame2.TextRange.Font.Bold = False
           .NumberFormat = "0,0000"
           .Position = xlLabelPositionOutsideEnd
           .Font.Name = "Calibri"
           .Font.Size = 10
       End With
       For Each p In .Points
           labelItems = Split(p.DataLabel.Text, vbLf)
           labelItems(1) = Format(Replace(labelItems(1), ".", ","), "0.00")
           With p.DataLabel.Format.TextFrame2.TextRange
               'Load Label with Category and Value
               .Text = labelItems(0) & vbLf & labelItems(1)
               startPos = 1
               'Category
               length = Len(labelItems(0))
               color = ActiveSheet.Cells(categoryColorRow, colIndex).Font.color
               .Characters(startPos, length).Font.Bold = True
               .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
               'Value
               color = ActiveSheet.Cells(valueColorRow, colIndex).Font.color
               startPos = startPos + length + 1
               length = Len(labelItems(1))
               .Characters(startPos, length).Font.Bold = True
               .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
           End With
           colIndex = colIndex + 1
       Next
   End With
End Sub

EDIT

Solved by FaneDuru:

Answer 1

As I said in my above comment, you need to extract the series ranges rows from their formula. Please, test the above adapted code doing that:

Sub Labels_SourceROWS_v2()
   Dim p As point, CatValueLength As Variant, dls As DataLabels, length As Long
   Dim labelItems As Variant, categoryColorRow As Long
   Dim valueColorRow As Long, colIndex As Long, color As Long
   Dim valueText As String, percentText As String, startPos As Long
   
   If TypeName(Selection) = "Range" Then MsgBox "You forgot selecting a chart...": Exit Sub

   categoryColorRow = 1
   With ActiveChart.SeriesCollection(1)
       .HasDataLabels = True

       'new code lines exgtracting the necesssary variables value:__
       valueColorRow = Range(Split(.Formula, ",")(2)).row
       categoryColorRow = Range(Split(.Formula, ",")(1)).row
       colIndex = Range(Split(.Formula, ",")(1)).column
       '____________________________________________________________

       With .DataLabels
           .ShowValue = True
           .ShowCategoryName = True
           .Separator = vbLf
           .Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
           .Format.TextFrame2.TextRange.Font.Bold = False
           .NumberFormat = "0,0000"
           .Position = xlLabelPositionOutsideEnd
           .Font.name = "Calibri"
           .Font.size = 10
        End With
       
       For Each p In .points
           labelItems = Split(p.DataLabel.Text, vbLf)
           labelItems(1) = Format(VBA.Replace(labelItems(1), ".", ","), "0.00")
           With p.DataLabel.Format.TextFrame2.TextRange
               'Load Label with Category and Value:
               .Text = labelItems(0) & vbLf & labelItems(1)
               startPos = 1
               'Category:
               length = Len(labelItems(0))
               color = ActiveSheet.cells(categoryColorRow, colIndex).Font.color
               .Characters(startPos, length).Font.Bold = True
               .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
               'Value:
               color = ActiveSheet.cells(valueColorRow, colIndex).Font.color
               startPos = startPos + length + 1
               length = Len(labelItems(1))
               .Characters(startPos, length).Font.Bold = True
               .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
           End With
           colIndex = colIndex + 1
       Next
   End With
End Sub

Please, send some feedback after testing it