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
Cells(valueColorRow, colIndex)
and Cells(valueColorRow, colIndex)
point to wrong cells.colIndex
is derived from chart series formula.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