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

#### Getting started with color

Let’s start with a few of the color concepts that we’ll use in the functions I’m going to show you. All the functions mentioned can be found in the usefulColorStuff module of the cDataSet.xlsm workbook.

#### RGB

The RGB color model is covered here and is the simplest representation of color model, whose main usage is for the specification of color on electronic devices such as computer screens. The combination of values ranging from 0-255 for each of the colors red, green and blue (hence RGB) leads to a particular color. In VBA these can be combined with the RGB(r,g,b) function to produce a single number which can be applied, for example as the background color of a cell. That gives a possible range of 0-16777215 different colors, where rgb(255,255,255) = 16777215 – the color white, and rgb(0,0,0) gives 0 – the color black.

For web design, these color codes are normally represented as hexadecimal, from #0 to #ffffff, made up of the hex values for #red.green.blue. One thing to watch out for is that the order of bytes is reversed from the natural VBA order.

For example hex(rgb(255,0,0)) is #ff but the hexHtml representation for rgb(255,0,0) is #ff0000. The byte order is imply reversed. Here are some functions to convert back and forwards to RGB

#### 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.

#### 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
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
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
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
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 Function```