There are a few items on this site that cover color ramps and other color manipulation topics. I’ve built up a few snippets on color management in VBA so I thought I should centralize them for easy reference. There is a Google Apps Script of most of this stuff on this site also. See Playing around with GAS color

**Page Content**hide

#### Getting started with color

#### RGB

#### Convert to and from htmlHex

#### Luminance

Luma is a measure of light in a color that can be used to determine whether there is a good contrast between two colors. I use it to pick the color of text I should use given a background color.

#### Calculate luminance

#### Contrast ratio

This is the ratio of contrast between 2 colors. The w3 organization has recommendations on suitable contrast ratios that improve legibility.

#### Calculate contrast ratio

You can see it gets harder to read the low contrast ratios.

**CYMK** Cyan, Yellow, Magenta, Black (the k of cymk), is another color representation model that is used in printing systems. If you look at the ink colors in your printer you’ll see that typically they are these colors. Whereas RGB was an additive system (red, green, blue adding together to eventually make white at maximum values), cymk is a subtractive system (maximum values are black). When you consider that CYMK is about printing, and a blank sheet of paper is white this makes sense. This is a very different color model to RGB and there is not a direct mapping, but here’s an approximation of how to convert between the two

p.black = min(1 - p.red / 255, 1 - p.green / 255, 1 - p.blue / 255) If p.black < 1 Then p.cyan = (1 - p.red / 255 - p.black) / (1 - p.black) p.magenta = (1 - p.green / 255 - p.black) / (1 - p.black) p.yellow = (1 - p.blue / 255 - p.black) / (1 - p.black) End If

#### HSL

This is a model based on Hue, saturation and lightness. Hue is 0- 360, and saturation and lightness is a percentage. Acknowledgement to http://www.easyrgb.com/ for the algorithm.

#### Calculate HSL

Public Function hslToRgb(p As colorProps) As Long ' adapted from // http://www.easyrgb.com/ Dim x1 As Double, x2 As Double, h As Double, s As Double, l As Double, _ red As Double, green As Double, blue As Double h = p.hue / 360 s = p.saturation / 100 l = p.lightness / 100 If s = 0 Then red = l * 255 green = l * 255 blue = l * 255 Else If l < 0.5 Then x2 = l * (1 + s) Else x2 = (l + s) - (l * s) End If x1 = 2 * l - x2 red = 255 * hueToRgb(x1, x2, h + (1 / 3)) green = 255 * hueToRgb(x1, x2, h) blue = 255 * hueToRgb(x1, x2, h - (1 / 3)) End If hslToRgb = rgb(red, green, blue) End Function

Public Function rgbToHsl(rgbColor As Long) As colorProps ' adapted from // http://www.easyrgb.com/ Dim r As Double, g As Double, b As Double, d As Double, _ dr As Double, dg As Double, db As Double, mn As Double, mx As Double, _ p As colorProps r = rgbRed(rgbColor) / 255 g = rgbGreen(rgbColor) / 255 b = rgbBlue(rgbColor) / 255 mn = min(r, g, b) mx = max(r, g, b) d = mx - mn ' HSL sets here p.hue = 0 p.saturation = 0 ' lightness p.lightness = (mx + mn) / 2 If (d <> 0) Then ' saturation If (p.lightness < 0.5) Then p.saturation = d / (mx + mn) Else p.saturation = d / (2 - mx - mn) End If ' hue dr = (((mx - r) / 6) + (d / 2)) / d dg = (((mx - g) / 6) + (d / 2)) / d db = (((mx - b) / 6) + (d / 2)) / d If r = mx Then p.hue = db - dg ElseIf g = mx Then p.hue = (1 / 3) + dr - db Else p.hue = (2 / 3) + dg - dr End If 'force between 0 and 1 If p.hue < 0 Then p.hue = p.hue + 1 If p.hue > 1 Then p.hue = p.hue - 1 Debug.Assert p.hue >= 0 And p.hue <= 1 End If p.hue = p.hue * 360 p.saturation = p.saturation * 100 p.lightness = p.lightness * 100 rgbToHsl = p End Function

Private Function hueToRgb(a As Double, b As Double, h As Double) As Double ' adapted from // http://www.easyrgb.com/ If h < 0 Then h = h + 1 If h > 1 Then h = h - 1 Debug.Assert h >= 0 And h <= 1 If (6 * h < 1) Then hueToRgb = a + (b - a) * 6 * h ElseIf (2 * h < 1) Then hueToRgb = b ElseIf (3 * h < 2) Then hueToRgb = a + (b - a) * ((2 / 3) - h) * 6 Else hueToRgb = a End If End Function

#### Text color

Although you can figure out contrasting colors by manipulating the r,g and b values, I think it’s better to use just black and white, and deciding on which by the value of the luminance – high luminance, use black, low, use white.

#### Colorprops custom type.

Since all these can be useful and are straightforward to calculated, I use a custom type to store them all in. That way I can other color spaces as I need to without disturbing much. So far the type looks like this

Public Type colorProps ' this is a single type to hold everything i know how to calculate about a color rgb As Long red As Long green As Long blue As Long htmlHex As String textColor As Long luminance As Double contrastRatio As Double cyan As Double magenta As Double yellow As Double black As Double hue As Double saturation As Double lightness As Double End Type

#### Populating the colorProps type

Public Function makeColorProps(rgbColor As Long) As colorProps Dim p As colorProps, p2 As colorProps 'store the source color p.rgb = rgbColor 'split the components p.red = rgbRed(rgbColor) p.green = rgbGreen(rgbColor) p.blue = rgbBlue(rgbColor) 'the html hex rgb equivalent p.htmlHex = rgbToHTMLHex(rgbColor) 'the w3 algo for luminance p.luminance = w3Luminance(rgbColor) 'determine whether black or white background If (p.luminance < 0.5) Then p.textColor = vbWhite Else p.textColor = vbBlack End If 'contrast ratio - to comply with w3 recs 1.4 should be at least 10:1 for text p.contrastRatio = contrastRatio(p.textColor, p.rgb) ' myck - just an estimate p.black = min(1 - p.red / 255, 1 - p.green / 255, 1 - p.blue / 255) If p.black < 1 Then p.cyan = (1 - p.red / 255 - p.black) / (1 - p.black) p.magenta = (1 - p.green / 255 - p.black) / (1 - p.black) p.yellow = (1 - p.blue / 255 - p.black) / (1 - p.black) End If ' calculate hsl + hsv and other wierd things p2 = rgbToHsl(p.rgb) p.hue = p2.hue p.saturation = p2.saturation p.lightness = p2.lightness p.value = rgbToHsv(p.rgb).value p2 = rgbToXyz(p.rgb) p.x = p2.x p.y = p2.y p.z = p2.z p2 = rgbToLab(p.rgb) p.LStar = p2.LStar p.aStar = p2.aStar p.bStar = p2.bStar p2 = rgbToLch(p.rgb) p.cStar = p2.cStar p.hStar = p2.hStar makeColorProps = p End Function

#### The color table

In the cDataSet.xlsm workbook (colorTable tab), there is a large table of colors. These are Pantone colors, html colors, dulux paint colors and various others. I’ll be adding to them over time, but also creating a REST queryable source that will allow you look up colors by type and name. Here’s the headings and the beginning of that table

The 4th column onwards were all calculated using the formulas described above. To understand the code below you’ll probably need to be familiar with Data Manipulation Classes, which are used for excel data abstraction. Pretty straightforward usage for the purposes of this.

#### Updating the color map

Public Sub colorMap() Dim dr As cDataRow, p As colorProps With getcolorMap(False) ' get all we know about each pantone color For Each dr In .rows With dr ' get all we know about this color p = makeColorProps(htmlHexToRgb(.toString("hex"))) .cell("magenta").value = p.magenta .cell("yellow").value = p.yellow .cell("black").value = p.black .cell("cyan").value = p.cyan .cell("red").value = p.red .cell("green").value = p.green .cell("blue").value = p.blue .cell("htmlHex").value = p.htmlHex .cell("rgb").value = p.rgb .cell("textcolor").value = p.textColor .cell("luminance").value = p.luminance .cell("contrastRatio").value = p.contrastRatio .cell("value").value = p.value .cell("hue").value = p.hue .cell("saturation").value = p.saturation .cell("lightness").value = p.lightness .cell("x").value = p.x .cell("y").value = p.y .cell("z").value = p.z .cell("lstar").value = p.LStar .cell("astar").value = p.aStar .cell("bstar").value = p.bStar .cell("cstar").value = p.cStar .cell("hstar").value = p.hStar ' color the row with and use a friendly text color .where.Interior.color = p.rgb .where.Font.color = p.textColor End With Next dr .bigCommit .tearDown End With End Sub

Public Function getcolorMap(Optional curt As Boolean = True) As cDataSet Dim ds As cDataSet Set ds = New cDataSet If curt Then ds.populateData toEmptyRow(wholeSheet("colorTable").Resize(, 3)), , , True, , , , "name" Else ds.populateData wholeSheet("colorTable"), , , True, , , True, "name" End If Set getcolorMap = ds End FunctionFor help and more information join our forum,follow the blog or follow me on twitter .