excelvbachartslabel

Color Excel chart data labels by categories for data arranged in two columns


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

How can I make the code work for data arranged in two columns?

Replacing

Dim categoryColorRow As Long
Dim valueColorRow As Long
categoryColorRow = 1 
valueColorRow = 2
colIndex = 2 

with

Dim categoryColorCol As Long
Dim valueColorCol As Long
categoryColorCol = 1 
valueColorCol = 2 
colIndex = 2 

does not change the behavior of the code.

This is the whole routine for rows:

Sub Labels_SourceROWS()
  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
          .ShowPercentage = True
          .Separator = vbLf
          .Format.TextFrame2.TextRange.Font.Bold = False
          .NumberFormat = "#.##0,00;- #.##0,00"
          .Position = xlLabelPositionBestFit
          .Font.Name = "Arial Narrow"
          .Font.Size = 8
      End With
      For Each p In .Points
          labelItems = Split(p.DataLabel.Text, vbLf)
          labelItems(1) = Format(Replace(labelItems(1), ".", ","), "0.00")
          labelItems(2) = Format(Replace(labelItems(2), ".", ","), "0.00%")
          With p.DataLabel.Format.TextFrame2.TextRange
              'load datalabel
              .Text = labelItems(0) & vbLf & labelItems(1) & vbLf & labelItems(2)
              startPos = 1
              length = Len(labelItems(0)) 'Category
              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
              'Percentage
              color = ActiveSheet.Cells(valueColorRow, colIndex).Font.color
              startPos = startPos + length + 1
              length = Len(labelItems(2))
              .Characters(startPos, length).Font.Bold = False
              .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
          End With
          colIndex = colIndex + 1
      Next
  End With
End Sub

Solution

  • Sub Labels_SourceCOLUMNS()
       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 valueColorCol As Long
       Dim colIndex As Long
       Dim color As Long
       Dim valueText As String
       Dim percentText As String
       Dim startPos As Long
       categoryColorRow = 1
       valueColorCol = 2
       ' colIndex = 2
    '   ActiveSheet.ChartObjects(1).Activate
    '    Dim s As Series
    '    Set s = ActiveChart.SeriesCollection(1)
    '    Stop
       With ActiveChart.SeriesCollection(1)
           colIndex = Range(Split(.Formula, ",")(1)).Column
           categoryColorRow = Range(Split(.Formula, ",")(1)).Row ' **
           .HasDataLabels = True
           With .DataLabels
               .ShowValue = True
               .ShowCategoryName = True
               .ShowPercentage = True
               .Separator = vbLf
               .Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
               .Format.TextFrame2.TextRange.Font.Bold = False
               .NumberFormat = "0,0000"
               .Position = xlLabelPositionOutsideEnd
               .Font.Name = "Arial Narrow"
               .Font.Size = 10
           End With
           For Each p In .Points
                startPos = 1
               labelItems = Split(p.DataLabel.Text, vbLf)
               'labelItems(1) = Format(Replace(labelItems(1), ".", ","), "0.00") 'no need
               labelItems(2) = Format(Replace(labelItems(2), ".", ","), "0.00%")
               With p.DataLabel.Format.TextFrame2.TextRange
                   ' load datalabel with text
                   .Text = labelItems(0) & vbLf & labelItems(1) & vbLf & labelItems(2)
                   length = Len(labelItems(0)) 'Category
                   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(categoryColorRow, colIndex + 1).Font.color
                   startPos = startPos + length + 1
                   length = Len(labelItems(1))
                   .Characters(startPos, length).Font.Bold = True
                   .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
    
                   color = vbBlack
                   startPos = startPos + length + 1
                   length = Len(labelItems(2))
                   .Characters(startPos, length).Font.Bold = False
                   .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
               End With
               categoryColorRow = categoryColorRow + 1
           Next
       End With
    End Sub
    
    
    

    enter image description here