Colour Excel stacked chart series accurately from cell fill

Question

(Using Excel 365 for Enterprise) I regularly create stacked column charts where the series are drawn from a fixed list of categories, and each category must have a specific (externally defined) colour.

For each chart the data need to be ordered by prevalence, so sometimes a given category might appear as Series 1, other times Series 12, and so on. Pasting new data into the existing sheet/chart means the colours and categories are mismatched. Previously I have manually set each series fill (custom RGB values) for each new chart, but would like to be more efficient.

I have a VBA macro that can set the chart series colour from the fill colour of the cell holding the data (my data cells do use the correct colours as per illustration below):

'Source https://www.get-digital-help.com/format-fill-color-on-a-column-chart-based-on-cell-color/#bar
'Name macro
Sub ColorChartBarsbyCellColor()
 
'Dimension variables and declare data types
Dim txt As String, i As Integer
 
'Save the number of chart series to variable c
c = ActiveChart.SeriesCollection.Count
 
'Iterate through chart series
For i = 1 To c
 
'Save seriescollection formula to variable txt
txt = ActiveChart.SeriesCollection(i).Formula
 
'Split string save d to txt using a comma ","
arr = Split(txt, ",")
 
'The With ... End With statement allows you to write shorter code by referring to an object only once instead of using it with each property.
With ActiveChart.Legend.LegendEntries(i)
 
'The SET statement allows you to save an object reference to a variable, the image above demonstrates a macro that assigns a range reference to a range object.
'Save a range object based on variable arr to variable vAdress
Set vAddress = ActiveSheet.Range(arr(2))
 
'Copy cell color from cell and use it to color bar chart
.LegendKey.Interior.Color = ThisWorkbook.Colors(vAddress.Cells(1).Interior.ColorIndex)
End With
 
'Continue with next series
Next i
End Sub

This appears to work in that colours are assigned, but they are not quite correct. Some are close, others not, as in the illustration below.

Others have commented on the VBA's source page, and the author did provide further code to apparently address this issue, but then no responses to those who asked (over a year ago) exactly how to make it work with the original macro.

'Source https://www.get-digital-help.com/format-fill-color-on-a-column-chart-based-on-cell-color/#comment-430898
Sub ColorChartColumnsbyCellColor()
With Sheets("Color chart columns").ChartObjects(1).Chart.SeriesCollection(1)
 
    Set vAddress = ActiveSheet.Range(Split(Split(.Formula, ",")(1), "!")(1))
     
    For i = 1 To vAddress.Cells.Count
         
        CS = ThisWorkbook.Colors(vAddress.Cells(i).Interior.ColorIndex)
         
        R = CS Mod 256
        G = CS \ 256 Mod 256
        B = CS \ 65536 Mod 256
         
        .Points(i).Format.Fill.ForeColor.RGB = RGB(R, G, B)
     
    Next i
     
End With
 
End Sub

I feel I am close to a solution here but falling at the last hurdle. Is it possible to add the second block of code into the first block, to make a working macro that will accurately set chart series colour from the data cell fill? Thank you.

Source links for ease: main code and additional block.

Answer 1

Here is a simpler routine:

Sub ColorChartBarsbyCellColor()

  Dim nSrs As Long
  nSrs = ActiveChart.SeriesCollection.Count

  'Iterate through chart series
  Dim iSrs As Long
  For iSrs = 1 To nSrs

    'Get series formula
    Dim sFmla As String
    sFmla = ActiveChart.SeriesCollection(iSrs).Formula

    'Split series formula at commas "," to create array
    Dim vFmla As Variant
    vFmla = Split(sFmla, ",")
    
    ' Find Y value range
    Dim rYValues As Range
    Set rYValues = Range(vFmla(2))

    'The With ... End With statement allows you to write shorter code by referring to an object only once instead of using it with each property.
    With ActiveChart.SeriesCollection(iSrs)

      'Copy cell color from cell and use it to color bar chart
      .Format.Fill.ForeColor.RGB = rYValues.Interior.Color
    End With

  Next iSrs
End Sub