Full example on GitHub: https://github.com/DanGolding/Scatter-plot-with-color-grading-in-Excel
If your colour data have only a few discrete values, the easiest way is to plot it as different series as shown here. However, if you have sequential data, you will need to use VBA to loop through each point of the data series and change its colour.
Using the macro editor, it is fairly easy to find the code to change the colour of an individual marker. You can then modify it to fit in a loop. This code is shown later. The challenge is to now choose a good colour mapping. This answer provides code that creates a mapping that is a gradient from one colour to another by a simple linear modulation of the individual RGB channels. However, I find that a more natural mapping for sequential data is to hold the hue and saturation of the colour constant and then vary lightness/luminace channel. This is, for example, how Excel varies the standard colours in the colour picker:
Luckily, you can expose an API function to convert from the HLS colour space to the RGB colourspace required to set the colour of a marker. To do this, add the following line of code to the top of your module:
Public Declare PtrSafe Function ColorHLSToRGB Lib "shlwapi.dll" (ByVal wHue As Long, ByVal wLuminance As Long, ByVal wSaturation As Long) As Long
Note that I have added PtrSafe
in the line above as this seems to make the function work with both 32-bit and 64-bit versions of Excel.
Through some experimentation, I found that you can't make the wLuminance
channel higher than 240
so I use the following function to map our colouring data (column T in the question) to range from 0
to 240
:
Function normalize(datum As Variant, dataMin As Double, dataMax As Double) As Integer
normalize = CInt(((datum - dataMin) / (dataMax-dataMin)) * 241)
End Function
The final code to colour the chart is
Sub colourChartSequential()
Dim data As Variant
Dim dataMin As Double
Dim dataMax As Double
data = Range("T1:T50") 'Modify this as needed, probably to be more dynamic
dataMin = WorksheetFunction.min(data) 'Note this doesn't work if your data are formatted as dates for some reason...
dataMax = WorksheetFunction.max(data)
With Worksheets("Sheet1").ChartObjects("Chart 1").Chart.FullSeriesCollection(1) 'Change "Chart 1" to the name of your chart
Dim Count As Integer
For Count = 1 To UBound(data)
datum = data(Count, 1)
.Points(Count).Format.Fill.BackColor.rgb = ColorHLSToRGB(161, normalize(datum, dataMin, dataMax), 220)
Next Count
End With
End Sub
Note that I called ColorHLSToRGB(161, normalize(datum, dataMin, dataMax), 220)
with a hue value of 161
and a saturation value of 220
. I got these values from the colour picker by starting from a base colour, then choosing more colours and then changing the drop down (highlighted in red below) from RGB to HSL. Also note that the bar that ranges from black through blue to white on the right is the colour mapping you get by only varying luminance.
By the way, if you want to adapt this for divergent data, I suggest chanding the normalization function to range from 240 down to 120 (so 240 for low values so that it's white near zero) and then adapting the code to something like this (note the codes assumes the data diverge around 0
but you can always change that):
Function normalizeDivergent(datum As Variant, dataMin As Double, dataMax As Double) As Integer
normalizeDivergent = 240 - CInt(((datum - dataMin) / (dataMax - dataMin)) * 121)
End Function
Sub colourChartDivergent()
Dim data As Variant
Dim dataMin As Double
Dim dataMax As Double
Dim lastRow As Integer
lastRow = Range("T1").End(xlDown).row
data = Range("T1:T" & lastRow)
dataMin = WorksheetFunction.min(data)
dataMax = WorksheetFunction.max(data)
dataMax = WorksheetFunction.max(dataMax, -dataMin)
dataMin = 0
With Worksheets("Sheet1").ChartObjects("Chart 1").Chart.FullSeriesCollection(1)
Dim Count As Integer
For Count = 1 To UBound(data)
datum = data(Count, 1)
If datum > 0 Then
.Points(Count).Format.Fill.BackColor.rgb = ColorHLSToRGB(161, normalizeDivergent(datum, dataMin, dataMax), 220)
Else
.Points(Count).Format.Fill.BackColor.rgb = ColorHLSToRGB(0, normalizeDivergent(-datum, dataMin, dataMax), 220)
End If
Next Count
End With
End Sub
Which produces something like
EDIT:
After reading this excellent article: http://vis4.net/blog/posts/avoid-equidistant-hsv-colors/ which lead me to http://tools.medialab.sciences-po.fr/iwanthue/theory.php and https://vis4.net/blog/posts/mastering-multi-hued-color-scales/ I realised that interpolating in the HSL space is also flawed. Converting to CIE L*a*b* / HCL colour spaces in VBA and then performing the Bezier interpolation and lightness correction suggested by vis4.net seemed too daunting. So instead I used their awesome tool to design a colour map look up table: http://gka.github.io/palettes/#diverging|c0=DarkRed,LightSalmon,white|c1=white,PaleTurquoise,MediumBlue|steps=255|bez0=1|bez1=1|coL0=1|coL1=1 that is hopefully more perceptually linear than my original HSL interpolation. Note that I tried to choose colour so that the lightness graph (the black diagonal lines below the colour bar) was roughly symmetrical so that perceived lightness maps to absolute value)
Step one is to copy the first block of hex numbers and save them as a text file:
Then in Excel I used DATA -> From Text to import the hex numbers (space delimited), transposed them to go down column A, cleaned them up using the formula =MID(A1,2,6)
going down column B and then split the RGB components into columns C - E using the formulae =HEX2DEC(LEFT(B1,2))
for the red channel, =HEX2DEC(MID(B1,3,2))
for the blue channel and =HEX2DEC(RIGHT(B1,2))
for the green channel.
I then tested these RGB values by colouring in cells in column G using this VBA code:
Sub makeColourBar()
Dim row As Integer
For row = 1 To 255
Range("G" & row).Interior.color = rgb(Range("C" & row).Value, Range("D" & row).Value, Range("E" & row).Value)
Next row
End Sub
which resulted correctly in
Now to apply this colour map to an x-y-scatter chart I wrote this code
Function normalizeLookUp(datum As Variant, dataMin As Double, dataMax As Double, n As Integer) As Integer
normalizeLookUp = CInt(((datum - dataMin) / (dataMax - dataMin)) * (n - 1)) + 1
End Function
Sub colourChartLookUp()
Dim data As Variant
Dim dataMin As Double
Dim dataMax As Double
Dim lastRow As Integer
lastRow = Range("H1").End(xlDown).row
data = Range("H1:H" & lastRow)
dataMin = WorksheetFunction.min(data)
dataMax = WorksheetFunction.max(data)
dataMax = WorksheetFunction.max(dataMax, -dataMin)
dataMin = -dataMax
With Worksheets("Colour Map").ChartObjects("Chart 1").Chart.FullSeriesCollection(1)
Dim Count As Integer
Dim colourRow As Integer
For Count = 1 To UBound(data)
datum = data(Count, 1)
colourRow = normalizeLookUp(datum, dataMin, dataMax, 255)
.Points(Count).Format.Fill.BackColor.rgb = rgb(Range("C" & colourRow).Value, Range("D" & colourRow).Value, Range("E" & colourRow).Value)
Next Count
End With
End Sub
which results in
The downside is that your colour map is stored on one of your worksheets (although you could store it as a VBA array instead) but in the end you should get a colour mapping that is perceptually uniform and thus more useful for interpreting data.
Note that for the final piece of the puzzle, you might want to read Adding a color bar to a chart.