Defined coloring of dynamic diagrams

[WalmitAal]

Hi all,
I would like to color the diagrams "Result" automatically according to the specified color.
However, the diagrams should be based entirely on the arrays and adapt themselves completely dynamically.
--> For example, if I add "Spain", Spain should also be added in the color green in all charts, Spain should also
be added in the color green.
The chart type varies and is therefore not limited to a barchart and linechart. However, it does not matter whether existing charts are only colored or completely new ones are created.

I have already been able to create the following code using ChatGPT (I hope it is allowed for questions). However, this is only limited to non-dynamic areas.

The result should look something like this

In advance, many thanks for any help

Sub FormatDiagramAsCellValue_adacoolio()
Dim targetNameRange As Range
Dim targetColorCodeRange As Range
Dim selectedChart As chartObject
Dim series As series
Dim cellName As Range
Dim cellColor As Range
Dim targetName As String
Dim targetColorCode As String
Dim chartName As String
' Disable updates to speed up execution
Application.ScreenUpdating = False
' Prompt for the range of names
On Error Resume Next
Set targetNameRange = Application.InputBox("Select range for names", Type:=8)
On Error GoTo 0
' Check if the user canceled the input or selected an invalid range
If targetNameRange Is Nothing Then
MsgBox "Canceled or invalid range selected for names.", vbExclamation
GoTo CleanupAndExit
End If
' Prompt for the range of color codes
On Error Resume Next
Set targetColorCodeRange = Application.InputBox("Select range for color codes", Type:=8)
On Error GoTo 0
' Check if the user canceled the input or selected an invalid range
If targetColorCodeRange Is Nothing Then
MsgBox "Canceled or invalid range selected for color codes.", vbExclamation
GoTo CleanupAndExit
End If
' Ask the user for the chart name
chartName = InputBox("Enter the chart name:")
' Check if a chart with the specified name exists
On Error Resume Next
Set selectedChart = ActiveSheet.ChartObjects(chartName)
On Error GoTo 0
If selectedChart Is Nothing Then
MsgBox "Chart with the specified name not found.", vbExclamation
GoTo CleanupAndExit
End If
' Iterate through all cells in the range for names
For Each cellName In targetNameRange
' Check if the cell is not empty
If Not IsEmpty(cellName.Value) Then
' Get the target name and target color code
targetName = cellName.Value
' Search for the target color code in the corresponding row in the range for color codes
On Error Resume Next
Set cellColor = targetColorCodeRange.Cells(cellName.Row - targetColorCodeRange.Rows(1).Row + 1, 1)
On Error GoTo 0
' Check if the target color code was found
If Not cellColor Is Nothing Then
' Get the target color code
targetColorCode = cellColor.Value
' Iterate through all data series in the selected chart
For Each series In selectedChart.chart.SeriesCollection
' Check if the name of the data series matches the target name
If InStr(1, series.Name, targetName, vbTextCompare) > 0 Then
' Set the fill color and line color of the data series according to the color code
series.Format.Fill.ForeColor.RGB = RGBFromHex(targetColorCode)
series.Format.Line.ForeColor.RGB = RGB(0, 0, 0) ' Black
series.Format.Line.Weight = 1 ' Width of the line
End If
Next series
End If
End If
Next cellName
CleanupAndExit:
' Enable updates
Application.ScreenUpdating = True
End Sub
Function RGBFromHex(hexCode As String) As Long
' Convert a hex code to an RGB color
Dim red As Integer, green As Integer, blue As Integer
red = CLng("&H" & Mid(hexCode, 2, 2))
green = CLng("&H" & Mid(hexCode, 4, 2))
blue = CLng("&H" & Mid(hexCode, 6, 2))
RGBFromHex = RGB(red, green, blue)
End Function

Financial_examples.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB
1	Country	Hex code for Country	Sum Units sold	Ø Profit				Sales per Day	Date	Canada	Germany	France	Mexico	United States of America
2	Canada	#BF00FF	247428,5	25208,8					01.01.2014	1186256,5	874935,1	1544720,7	1655822,9	1346026,5
3	Germany	#201C8F	199949	26377,6					01.06.2014	2725979,4	1611485,2	1647724,0	2210094,4	1323610,8
4	France	#FF00FF	242476	26914,4					01.12.2014	3959729,4	2283342,4	2389929,2	1633894,7	1731892,1
5	Mexico	#9932CC	203325	20768,0					01.03.2014	811132,5	479509,6	1559748,8	946494,6	1789974,5
6	United States of America	#008B8B	232627,5	21396,7					01.07.2014	2109549,3	1609549,8	1148065,1	926957,9	2308798,1
7		#32CD32							01.08.2014	952043,0	1046755,2	779802,1	1078756,0	2007266,1
8		#7CFC00							01.09.2014	938647,6	1255161,9	1753193,0	1022441,3	1429253,5
9		#2E8B57							01.10.2013	1229608,3	2555442,6	2390477,0	1166052,6	1954030,7
10									01.02.2014	1482166,0	1347335,9	1537438,5	1597700,4	1332890,7
11									01.09.2013	939195,2	1095488,2	821599,6	646694,2	981022,9
12									01.10.2014	2215924,5	3421587,3	3379661,6	1855574,3	1503072,3
13									01.11.2013	1419826,1	1718947,9	985577,3	1616106,4	1526745,6
14									01.12.2013	1587259,2	857856,9	935141,3	1325568,1	662615,6
15									01.04.2014	1593563,0	1394813,5	1332862,7	1026911,5	1616624,5
16									01.05.2014	783941,7	1317483,0	1042777,0	1116760,1	1949249,4
17									01.11.2014	952833,3	617106,5	1123994,6	1123522,8	1566757,0
18
19
Tabelle1

Cell Formulas
Range	Formula
J1:N1	J1	=TRANSPOSE(UNIQUE(financials[Country]))
A2:A6	A2	=UNIQUE(financials[Country])
C2:C6	C2	=SUMIFS(financials[Units Sold],financials[Country],A2#)
D2:D6	D2	=AVERAGEIFS(financials[Profit],financials[Country],A2#)
I2:I17	I2	=UNIQUE(financials[Date])
J2:N17	J2	=SUMIFS(financials[ [ Sales] ],financials[Country],J1#,financials[Date],I2#)
Dynamic array formulas.

Named Ranges
Name	Refers To	Cells
Country_a	=Tabelle1!$A$2#	C2:D2