I've been on a mission the past two weeks to craft a pair of macros to lighten and dark a cell fill color. The main reason I wanted to do this was to create complimentary colors for my spreadsheet formats on the fly given a specific color. Here is an example of how I would typically use this:
Color Codes Can Be Complicated!
In my pursuit to craft this code, I have had to do a TON of research on color codes and how to manipulate them. I was familiar with RGB and HEX, but had never delved into HSL and HSV. There are basic premises to each of these color coding systems, but when you start manipulating hues, saturations, the brightness, adding 16-base digits......I could go on, but I think you get the picture. It can get EXTREMELY complicated!
I Found Some Solutions!
After days of digging through countless forum posts (mostly on StackOverflow) and pulling many follicles of hair out off my scalp, I was able to come up with two solutions.
And since I'm such a nice guy, I'm going to share them with you :)
Not Perfect, But Do The Trick
Now these solutions aren't 100% perfect, but I'm hoping some mathematicians can help tweak my logic a bit. Why aren't they perfect in my eyes? Well, in my mind if I run the "Lighten" macro and then run the "Darken" macro, I should end of with my exact original color. With both solutions I was able to write, the color ends up being slightly off (typically only noticeable if you check the RGB color code).
I won't be able to thank you enough if you have time to look through all the math and figure out a way to get the code so it can be reversed! It's just a little out of my skillset to solve at this time.
Solution 1: RGB Manipulation (My Preferred Macro)
I found the logic used in the Lighten macro below in some forum and for the life of me cannot find it again! So I apologize for not being able to credit anyone for the algorithm. I reversed the algorithm (who knew algebra class would come in handy one day!) to create the algorithm used in the darkening macro.
Like I mentioned before, these two macros can't be toggled macro in forth to "undo" a shade. The colors will be super close but not exact (not sure if it's a rounding thing or what). If you can solve the issue PLEASE let me know how to fix it in the comments section below and I will update this article.
Lighten Cell Fill By A Shade
Sub FillColor_Lighten()
'PURPOSE: Lighten the cell fill by a shade while maintaining Hue (base Color)
'SOURCE: www.TheSpreadsheetGuru.com
Dim HEXcolor As String
Dim cell As Range
Dim Lighten As Integer
Dim r As Integer
Dim g As Integer
Dim b As Integer
Dim r_new As Integer
Dim g_new As Integer
Dim b_new As Integer
'Shade Settings
Lighten = 3 'recommend 3 (1-16)
'Optimize Code
Application.ScreenUpdating = False
'Loop through each cell in selection
For Each cell In Selection.Cells
'Determine HEX color code
HEXcolor = Right("000000" & Hex(cell.Interior.Color), 6)
'Determine current RGB color code
r = CInt("&H" & Right(HEXcolor, 2))
g = CInt("&H" & Mid(HEXcolor, 3, 2))
b = CInt("&H" & Left(HEXcolor, 2))
'Calculate new RGB color code
r_new = WorksheetFunction.Round(r + (Lighten * (255 - r)) / 15, 0)
g_new = WorksheetFunction.Round(g + (Lighten * (255 - g)) / 15, 0)
b_new = WorksheetFunction.Round(b + (Lighten * (255 - b)) / 15, 0)
'Debug.Print r_new, g_new, b_new
'Change enitre selection's fill color
cell.Interior.Color = RGB(r_new, g_new, b_new)
Next cell
End Sub
Darken Cell Fill By A Shade
Sub FillColor_Darken()
'PURPOSE: Darken the cell fill by a shade while maintaining Hue (base Color)
'SOURCE: www.TheSpreadsheetGuru.com
Dim HEXcolor As String
Dim cell As Range
Dim Darken As Integer
Dim r As Integer
Dim g As Integer
Dim b As Integer
Dim r_new As Integer
Dim g_new As Integer
Dim b_new As Integer
'Shade Settings
Darken = 3 'recommend 3 (1-16)
'Optimize Code
Application.ScreenUpdating = False
'Loop through each cell in selection
For Each cell In Selection.Cells
'Determine HEX color code
HEXcolor = Right("000000" & Hex(cell.Interior.Color), 6)
'Determine current RGB color code
r = CInt("&H" & Right(HEXcolor, 2))
g = CInt("&H" & Mid(HEXcolor, 3, 2))
b = CInt("&H" & Left(HEXcolor, 2))
'Calculate new RGB color code
r_new = WorksheetFunction.Round((r * 15 - 255 * Darken) / (15 - Darken), 0)
g_new = WorksheetFunction.Round((g * 15 - 255 * Darken) / (15 - Darken), 0)
b_new = WorksheetFunction.Round((b * 15 - 255 * Darken) / (15 - Darken), 0)
'Change enitre selection's fill color
On Error Resume Next
cell.Interior.Color = RGB(r_new, g_new, b_new)
On Error GoTo 0
Next cell
End Sub
Solution 2: RGB to HSV Manipulation
So far this code doesn't work as well with certain colors as the first solution, but I am posting it in hopes that someone can save it.
The idea behind this is to convert the RGB color code into a HSV (hue, saturation, brightness value) code. Once in HSV, you can specifically target the "V" value while maintaining the hue and saturation, essentially allowing you to maintain the base color. Once you manipulated the HSV color code, you translate it back to RGB and apply it to your cell fill.
I pulled this logic together straight from a great article entitled Lode's Computer Graphic Tutorial - Light and Color.
Sub HSV_Shading()
'PURPOSE: To lighten or darken a cell fill color while maintaining Hue (base color)
'SOURCE: www.TheSpreadsheetGuru.com
'LOGIC SOURCE: http://lodev.org/cgtutor/color.html#The_HSL_Color_Model_
Dim HEXcolor As String
Dim cell As Range
Dim ShadeRate As Integer
'Rate You wish to lighten (darken)
ShadeRate = 50 'I recommend 50 or 25 (Make negative to darken)
'Store ActiveCell to a variable
Set cell = ActiveCell
'Determine HEX color code
HEXcolor = Right("000000" & Hex(cell.Interior.Color), 6)
'Determine current RGB color code
r = CInt("&H" & Right(HEXcolor, 2)) / 256
g = CInt("&H" & Mid(HEXcolor, 3, 2)) / 256
b = CInt("&H" & Left(HEXcolor, 2)) / 256
'********************
'Convert RGB to HSV
'********************
maxColor = WorksheetFunction.Max(r, g, b)
minColor = WorksheetFunction.Min(r, g, b)
v = maxColor
If maxColor = 0 Then
s = 0
Else
s = (maxColor - minColor) / maxColor
End If
If s = 0 Then
h = 0
Else
If r = maxColor Then
h = (g - b) / (maxColor - minColor)
ElseIf g = maxColor Then
h = 2 + (b - r) / (maxColor - minColor)
Else
h = 4 + (r - g) / (maxColor - minColor)
End If
h = h / 6
If h < 0 Then h = h + 1
End If
'Output The HSV Color Code with adjustment rate
h = Int(h * 255)
s = Int(s * 255)
v = Int(v * 255) + ShadeRate
If v < 0 Then v = 0
'********************
'Conver HSV to RGB
'********************
h = h / 256
s = s / 256
v = v / 256
If s = 0 Then
r = g
g = b
b = v
End If
h = h * 6
i = Int(WorksheetFunction.RoundDown(h, 0))
f = h - i
p = v * (1 - s)
q = v * (1 - (s * f))
t = v * (1 - (s * (1 - f)))
Select Case i
Case 0: r = v: g = t: b = p
Case 1: r = q: g = v: b = p
Case 2: r = p: g = v: b = t
Case 3: r = p: g = q: b = v
Case 4: r = t: g = p: b = v
Case 5: r = v: g = p: b = q
End Select
'Output New RGB Color Code
r = Int(r * 255)
g = Int(g * 255)
b = Int(b * 255)
'Change Cell Fill To New Color
cell.Interior.Color = RGB(r, g, b)
End Sub
Any Other Ideas?
there were lots of algorithms floating around in many different coding languages. Let me know if you have a better or more efficient way of lightening or darkening a fill color while maintaining the essence of the color. I know there are simple ways to adjust the brightness of an RGB code by applying a percent to it, but I don't think the color outputs are visually appealing. I looking forward to your responses!
