I have a worksheet with 3 sheets. The first sheet is basically a setup file/ key for the rest of the workbook. I want to be able to edit the key in the first worksheet so after I run the macro all the other worksheets will changed based on the values in the 1st worksheet. the first worksheet is named "Treatment" and the key is located in G3 - G17. For example, if I have a "test1" in G3 on the "treatment" sheet with yellow fill, I want the cells containing "test1" in sheets 2 and 3 to have yellow fill anytime a cell has "test1". In sheet 2 I also have a graph. I would like the graph to also automatically update with the referencing the name and color I have in the treatment sheet. So the data with "test1" will have a yellow bar.
NOTE: My chart data is vertically, not horizontal like the macro I found. So, my x axis names are in column D and my data is in Columns I - xxxx. I have more than 1 graph so it depends.
I found the code below online and it works for the cells (BUT ONLY ON ONE WORKSHEET) and not the graph. Also, it only works on the active worksheet. The second code is my modified code to try and make it work in my application, but I have the following issues:
1. It only works on 1 sheet (active sheet) and not the others
2. I can't get it to automatically update the bar chart I have. I want to bar colors to be updated by the cell value (name) or by the cell fill color it is referencing.
Sub MatchColors()
Call LookupColor
Call MatchChartColors
End Sub
Private Sub MatchChartColors()
'Step 1: Declare your variables
Dim oChart As Chart
Dim MySeries As Series
Dim FormulaSplit As Variant
Dim SourceRangeColor As Long
'Step 2: Point to the active chart
On Error Resume Next
Set oChart = ActiveChart
'Step 3: Exit if no chart has been selected
If oChart Is Nothing Then
MsgBox "You must select a chart first."
Exit Sub
End If
'Step 4: Loop through the chart series
For Each MySeries In oChart.SeriesCollection
'Step 5: Ger source data range for the target series
FormulaSplit = Split(MySeries.Formula, ",")(2)
'Step 6: Capture the color in the first cell
SourceRangeColor = Range(FormulaSplit).Item(1).Interior.Color
'Step 7: Apply coloring
On Error Resume Next
MySeries.Format.Line.ForeColor.RGB = SourceRangeColor
MySeries.Format.Line.BackColor.RGB = SourceRangeColor
MySeries.Format.Fill.ForeColor.RGB = SourceRangeColor
If Not MySeries.MarkerStyle = xlMarkerStyleNone Then
MySeries.MarkerBackgroundColor = SourceRangeColor
MySeries.MarkerForegroundColor = SourceRangeColor
End If
'Step 8: Move to the next series
Next MySeries
End Sub
Private Sub LookupColor()
Dim DataTable As Range
Dim DataCell As Range
Dim DataRangeColor As Long
Dim ColorTable As Range
Dim ColorCell As Range
Dim ValueRange As Range
Dim ValueCell As Range
Dim i As Integer
Dim Count As Long
Count = ThisWorkbook.ActiveSheet.Range("E3").Value
i = Count + 2
Set DataTable = Range("D13: R13") ' Adjust range as needed
Set ColorTable = Range("C3: C" & i) ' Adjust range as needed
Set ValueRange = Range("D14:R14") ' Adjust range as needed
For Each ColorCell In ColorTable
For Each DataCell In DataTable
If DataCell.Value = ColorCell.Value Then
DataRangeColor = ColorCell.Interior.Color
DataCell.Interior.Color = DataRangeColor
End If
Next DataCell
Next ColorCell
For Each ValueCell In ValueRange
ValueCell.Interior.Color = ValueCell.Offset(-1, 0).Interior.Color
Next ValueCell
End Sub
My modified Code:
Sub MatchColors()
Call LookupColor
Call MatchChartColors
End Sub
Private Sub MatchChartColors()
'Step 1: Declare your variables
Dim oChart As Chart
Dim MySeries As Series
Dim FormulaSplit As Variant
Dim SourceRangeColor As Long
'Step 2: Point to the active chart
On Error Resume Next
Set oChart = ActiveChart
'Step 3: Exit if no chart has been selected
If oChart Is Nothing Then
MsgBox "You must select a chart first."
Exit Sub
End If
'Step 4: Loop through the chart series
For Each MySeries In oChart.SeriesCollection
'Step 5: Ger source data range for the target series
FormulaSplit = Split(MySeries.Formula, ",")(2)
'Step 6: Capture the color in the first cell
SourceRangeColor = Range(FormulaSplit).Item(1).Interior.Color
'Step 7: Apply coloring
On Error Resume Next
MySeries.Format.Line.ForeColor.RGB = SourceRangeColor
MySeries.Format.Line.BackColor.RGB = SourceRangeColor
MySeries.Format.Fill.ForeColor.RGB = SourceRangeColor
If Not MySeries.MarkerStyle = xlMarkerStyleNone Then
MySeries.MarkerBackgroundColor = SourceRangeColor
MySeries.MarkerForegroundColor = SourceRangeColor
End If
'Step 8: Move to the next series
Next MySeries
End Sub
Private Sub LookupColor()
Dim DataTable As Range
Dim DataCell As Range
Dim DataRangeColor As Long
Dim ColorTable As Range
Dim ColorCell As Range
Dim ValueRange As Range
Dim ValueCell As Range
Dim i As Integer
Dim Count As Long
Count = ThisWorkbook.ActiveSheet.Range("F21").Value
i = Count + 2
Set DataTable = Range("B3: C103") ' Adjust range as needed
Set ColorTable = Range("G3: G" & i) ' Adjust range as needed
For Each ColorCell In ColorTable
For Each DataCell In DataTable
If DataCell.Value = ColorCell.Value Then
DataRangeColor = ColorCell.Interior.Color
DataCell.Interior.Color = DataRangeColor
End If
Next DataCell
Next ColorCell
For Each ValueCell In ValueRange
ValueCell.Interior.Color = ValueCell.Offset(-1, 0).Interior.Color
Next ValueCell
End Sub
Bookmarks