Match Product Chart Colors to Excel Spreadsheet Cells – Pete’s VBA Solution

In the recent Friday Challenge: Create Pipeline Usage Chart

A user wanted to create a bar chart where the values had a specific color by product and also matched represented the size of the data.

image

Pete R. came up with an awesome VBA solution so that the colors will match the cell colors for a given product and apply those values to the bar chart. imageThanks Pete for the great solution.

 





Here is Pete’s write up:

 

I wanted to come up with a solution to the recent Friday Challenge, but I wanted the solution to be simple to implement, and dynamically updated. I thought that this challenge would be best solved with a little bit of VBA.

I started with a code that I found in “101 Ready-to-Use Excel Macros” written by Michael Alexander. This is listed in the book as Macro 83: Color Chart Series to Match Source Cell Colors. The code is as follows:

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: Get 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

 

The color matching macro worked great, but it did not dynamically change with new data entry. You would still have to manually color code all of the data to be charted and then run the macro to match the colors in the chart. I really wanted a method to perform some sort of LOOKUP of the data and return the colors. With that in mind I created the following bit of code:

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

 

This code defines the area of the sheet where the user defines the colors at the “ColorTable” and the individual cells that make it up as the “ColorCell”. The data range used to chart the data is defined as the “ValueRange” and each individual cell is a “ValueCell”.

There is a set of nested loops in the code. The code loops through each cell in the ColorTable and for each ColorCell loops through each DataCell in the DataTable and looks for a match in values. If the value in a DataCell matches a ColorCell then interior color (fill) of the DataCell will be made to match the ColorCell’s interior color (fill). Once the code loops through all of the DataCells it will move to the next ColorCell and continue looking for matches until all of the ColorCells have been run through the code.

 

Then I put all of the codes together and coordinate their actions in the correct order, I created the following code to drive it all:





Sub MatchColors()

Call LookupColor

Call MatchChartColors

End Sub

 

Finally to make it all simple to utilize I added a “Hot Key” (CTRL+SHIFT+M) to run the macro. I originally attempted to place button to control the macro, but since the code that matches the colors to the chart needed an active chart to be selected in order to operate, a button was not feasible. As soon as you click on the button it becomes the active object and not the chart, which cause the macro to fail. My solution was the “Hot Key” idea.

My final code is arranged like this:

Option Explicit

Sub MatchColors()

Call LookupColor





Call MatchChartColors

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

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

 

The last step I took was to assign a Shortcut key (Hot Key) to run the macro. To do this I opened the list of macros in This Workbook, selected the macro (MatchColors) and clicked Options. Then I set the Shortcut Key to CTRL+SHIFT+M.

clip_image002

Works like a charm.  Thanks again for the great solution Pete!

 

Video Demonstration

Check out the video here:

 

File Download

Try the code by downloading the sample file here:

Friday Challenge Answer – Pipeline Usage Chart – Petes Answer – VBA Solution

 

Steve=True





LEAVE A REPLY

Please enter your comment!
Please enter your name here