What can you learn here?
- ramp color scales
- gradient between colors
- Use a ramp library
Generalized Color Ramps
If you read A tagCloud in Outlook, How to create a tag cloud or Create a heatmap in Excel you would have seen reference to a heatmap scale. This is specific form of color ramp that calculates a color ranging from blue through red depending on it’s value compared to the rest of the range it is in. Here we will look at creating a generalized color ramp, and an extensible VBA library of useful ramps.
As usual this code is implemented in the cDataSet.xlsm module downloadable from Download Complete Projects. There is a Google Apps Script version of this library if you are a Google Docs user. See Charts and color ramps for how to make interesting charts using color ramps If you are interested in creating maps or shapes with heatmaps, here’s a one liner to do it.
How it works
You provide 2 or more colors, and the difference between their red, green and blue component values is calculated. A single RGB color is provided that you can use to represent the input value.
Example Color ramps
Here is the code to produce the ramps shown above. Public Sub testHeatMapScaleRamp() Dim m As Long, n As Long, r As Range Set r = Sheets("heatmapramp").Range("a1") r.Worksheet.Cells.Interior.color = vbWhite Const npoints = 200 For m = 0 To npoints r.Offset(, m).Interior.color = _ rampLibraryRGB("heatmap", 0, npoints, m) r.Offset(1, m).Interior.color = _ rampLibraryRGB("heatmaptowhite", 0, npoints, m) r.Offset(2, m).Interior.color = _ rampLibraryRGB("blacktowhite", 0, npoints, m) r.Offset(3, m).Interior.color = _ rampLibraryRGB("whitetoblack", 0, npoints, m) r.Offset(4, m).Interior.color = _ rampLibraryRGB("hotinthemiddle", 0, npoints, m) r.Offset(5, m).Interior.color = _ rampLibraryRGB("candylime", 0, npoints, m) r.Offset(6, m).Interior.color = _ rampLibraryRGB("heatcolorblind", 0, npoints, m) r.Offset(7, m).Interior.color = _ rampLibraryRGB("gethotquick", 0, npoints, m) r.Offset(8, m).Interior.color = _ rampLibraryRGB("greensweep", 0, npoints, m) Next mEnd Sub Here is the colorramp library defining them Public Function rampLibraryRGB(sName As String, min As Variant, _ max As Variant, Value As Variant, _ Optional brighten As Double = 0) As Long Select Case Trim(LCase(sName)) Case “heatmaptowhite” rampLibraryRGB = colorRamp(min, max, Value, _ Array(vbBlue, vbGreen, vbYellow, vbRed, vbWhite), , _ brighten) Case “heatmap” rampLibraryRGB = colorRamp(min, max, Value, _ Array(vbBlue, vbGreen, vbYellow, vbRed), , _ brighten) Case “blacktowhite” rampLibraryRGB = colorRamp(min, max, Value, _ Array(vbBlack, vbWhite), , brighten) Case “whitetoblack” rampLibraryRGB = colorRamp(min, max, Value, _ Array(vbWhite, vbBlack), , brighten) Case “hotinthemiddle” rampLibraryRGB = colorRamp(min, max, Value, _ Array(vbBlue, vbGreen, vbYellow, vbRed, _ vbYellow, vbGreen, vbBlue), , brighten) Case “candylime” rampLibraryRGB = colorRamp(min, max, Value, _ Array(RGB(255, 77, 121), RGB(255, 121, 77), _ RGB(255, 210, 77), RGB(210, 255, 77)), , _ brighten) Case “heatcolorblind” rampLibraryRGB = colorRamp(min, max, Value, _ Array(vbBlack, vbBlue, vbRed, vbWhite), , brighten) Case “gethotquick” rampLibraryRGB = colorRamp(min, max, Value, _ Array(vbBlue, vbGreen, vbYellow, vbRed), _ Array(0, 0.1, 0.25, 1), brighten) Case “greensweep” rampLibraryRGB = colorRamp(min, max, Value, _ Array(RGB(153, 204, 51), RGB(51, 204, 179)), , _ brighten) Case “terrain” rampLibraryRGB = colorRamp(min, max, Value, _ Array(vbBlack, RGB(0, 46, 184), RGB(0, 138, 184), _ RGB(0, 184, 138), _ RGB(138, 184, 0), RGB(184, 138, 0), _ RGB(138, 0, 184), vbWhite), , _ brighten) Case Else Debug.Assert False End Select End Function
ColorRamp Function
Intermediate colors
Aside from the min, max and value that you want the color calculated for, you can also provide an array of as many colors as you want. colorRamp will use these to ‘pass through’ – so for example a heatmap would be Array(vbBlue, vbGreen, vbYellow, vbRed). To get the exact effect you want, just add some more intermediate colors.
Ramp speed
By default, the rate at which the colors evolve between intermediate or ‘milestone’ colors is evenly divided. However if you wanted to modify that – for example the library entry ‘gethotquick’, spends longer on the red tone colors than on the blue – you can specify the ramp up speed for each milestone color as below – Case "gethotquick" rampLibraryRGB = colorRamp(min, max, Value, _ Array(vbBlue, vbGreen, vbYellow, vbRed), _ Array(0, 0.1, 0.25, 1))
Code
Here us the code for the colorRamp function. Public Function colorRamp(min As Variant, _ max As Variant, Value As Variant, _ Optional mileStones As Variant, _ Optional fractionStones As Variant, _ Optional brighten As Double = 1) ‘ create a value from a colorramp going through the array of milestones Dim spread As Double, ratio As Double, red As Double, _ green As Double, blue As Double, j As Long, _ lb As Long, ub As Long, cb As Long, r As Double, i As Long ‘—-defaults and set up milestones on ramp Dim ms() As Long Dim fs() As Double If IsMissing(mileStones) Then ReDim ms(0 To 4) ms(0) = vbBlue ms(1) = vbGreen ms(2) = vbYellow ms(3) = vbRed ms(4) = vbWhite Else ReDim ms(0 To UBound(mileStones) – LBound(mileStones)) j = 0 For i = LBound(mileStones) To UBound(mileStones) ms(j) = mileStones(i) j = j + 1 Next i End If ‘ tedious this is lb = LBound(ms) ub = UBound(ms) cb = ub – lb + 1 ‘ only 1 milestone – thats the color If cb = 1 Then colorRamp = ms(lb) Exit Function End If If Not IsMissing(fractionStones) Then If UBound(fractionStones) – LBound(fractionStones) <> _ cb – 1 Then MsgBox (“no of fractions must equal number of steps”) Exit Function Else ReDim fs(lb To ub) j = lb For i = LBound(fractionStones) To UBound(fractionStones) fs(j) = fractionStones(i) j = j + 1 Next i End If Else ReDim fs(lb To ub) For i = lb + 1 To ub fs(i) = i / (cb – 1) Next i End If ‘spread of range spread = max – min Debug.Assert spread >= 0 ratio = (Value – min) / spread Debug.Assert ratio >= 0 And ratio <= 1 ‘ find which slot For i = lb + 1 To ub If ratio <= fs(i) Then r = (ratio – fs(i – 1)) / (fs(i) – fs(i – 1)) red = rgbRed(ms(i – 1)) + (rgbRed(ms(i)) – rgbRed(ms(i – 1))) * r blue = rgbBlue(ms(i – 1)) + (rgbBlue(ms(i)) – rgbBlue(ms(i – 1))) * r green = rgbGreen(ms(i – 1)) + (rgbGreen(ms(i)) – rgbGreen(ms(i – 1))) * r colorRamp = RGB(lumRGB(red, brighten), _ lumRGB(green, brighten), _ lumRGB(blue, brighten)) Exit Function End If Next i Debug.Assert False End Function Private Function lumRGB(rgbCom As Double, brighten As Double) As Double Dim x As Double x = rgbCom * brighten If x > 255 Then x = 255 If x < 0 Then x = 0 lumRGB = x End Function
Public Function rgbRed(rgbColor As Long) As Long
rgbRed = rgbColor Mod &H100
End Function
Public Function rgbGreen(rgbColor As Long) As Long
rgbGreen = (rgbColor &H100) Mod &H100
End Function
Public Function rgbBlue(rgbColor As Long) As Long
rgbBlue = (rgbColor &H10000) Mod &H100
End Function
Summary
For more tips like this, take a look at Get Started Snippets In the meantime why not join our forum, follow the blog or follow me on twitter to ensure you get updates when they are available. You can also submit anything you want considered for publication, including any nice color ramps you come up, with on this site to our forum. There is a Google Apps Script version of this library if you are a Google Docs user. See Charts and color ramps for how to make interesting charts using color ramps.
Related pages