Stacked column Chart - Loop through Points

[mikeymay]

I want to show the following data in a stacked column chart where the Total column only has the data label (this is a stander column rather than stacked and I have set the fill for this to be non so it isn't visible other than the label) and the 3 categories with no data labels but stacked

Month	Total	PCD	EBD	NTU
Oct 20​	1294.071​	1294.071​
Nov 20​	65454.33​	27720.01​	37522.61​	211.7143​
Dec 20​	35958.27​	15493.94​	20312.68​	151.6518​
Jan 21​	29445.66​	20745.35​	7446.098​	1254.214​
Feb 21​	76208.91​	62160.55​	11244.43​	2803.929​
Mar 21​	76244.49​	23575.14​	50932.56​	1736.786​
Apr 21​	74539.93​	36732.54​	35615.04​	2192.357​
May 21​	59136.79​	18367.63​	39734.38​	1034.786​
Jun 21​	58406.57​	22859.23​	35246.38​	300.9643​
Jul 21​	52126.07​	26817.54​	24997.17​	311.3571​
Aug 21​	77879.59​	14119.71​	62678.48​	1081.393​
Sep 21​	52268.7​	34491.45​	17532.32​	244.9286​

The chart is shown as below

What I need to do then is loop through each of the points for the non total series and change the fill colour to that from cells that hold the Point names (PCD, EBD, NTU). So the cell with PCD is a pastel green, I need that point in each of the columns IF IT EXISTS, to be the same colour.


Thanks
Michael

 

[pbornemeier]

This code will color each series's blocks to match the interior of the cell that contain that series's name:

Option Explicit

Sub ColorColumnsToMatchSeriesNameInterior()

    Dim ser As Series
    Dim aryFormulaParts As Variant
    Dim strSeriesNameAddress As String
    
    With ActiveSheet.ChartObjects(1)
        For Each ser In .Chart.SeriesCollection
            If ser.Name <> "Total" Then
                ser.Select
                aryFormulaParts = Split(ser.Formula, ",")
                strSeriesNameAddress = Split(aryFormulaParts(0), "(")(1)
                With Selection.Format.Fill
                    .Visible = msoTrue
                    .ForeColor.RGB = Range(strSeriesNameAddress).Interior.Color
                    .Transparency = 0
                    .Solid
                End With
            End If
        Next

    End With

End Sub

When I pasted the table that you provided all numbers came across as text with an invisible "?" (Asc 63) at the end of the digits. I had to select the number block and run this code to get rid of the "?". If you copy the image back to your computer does the same thing happen?

Option Explicit

Sub TrimRight()

    Dim rngCell As Range
    For Each rngCell In Selection.Cells
        rngCell = Left(rngCell, Len(rngCell) - 1)
    Next
    
End Sub