VBA Code to Lighten or Darken Fill Colors in Excel

VBA Macro Code Shade Color Dark Light RGB HSV

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 three 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 two 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: Adjusting The TintAndShade Property

I got the inspiration for this solution from a blog post over at Daily Dose of Excel. I love this solution because it is COMPLETELY reversible! However, on certain colors it doesn't work so great. For example try to lighten RGB(0,176,80) or RGB(0,32,96). You will get a brighter color instead of a lighter one. But on most colors it works great!

Lighten Cell Fill By A Shade

Sub LightenFill()
'PURPOSE: Lighten cell or shape fill 1 shade
'SOURCE: www.TheSpreadsheetGuru.com

Dim cell As Range
Dim Lighten As Double

Lighten = 0.2 '(must be between 0 and 1)

'Modify all fill colors within selected cells
  If TypeName(Selection) = "Range" Then '(Handle Cells)
    For Each cell In Selection.Cells
      cell.Interior.TintAndShade = cell.Interior.TintAndShade + Lighten
    Next cell
  Else '(Handle Shapes)
    With Selection
      .Interior.TintAndShade = .Interior.TintAndShade + Lighten
    End With
  End If
    
End Sub

Darken Cell Fill By A Shade

Sub DarkenFill()
'PURPOSE: Darken cell or shape fill 1 shade
'SOURCE: www.TheSpreadsheetGuru.com

Dim cell As Range
Dim Darken As Double

Darken = 0.2 '(must be between 0 and 1)

'Modify all fill colors within selected cells
  If TypeName(Selection) = "Range" Then '(Handle Cells)
    For Each cell In Selection.Cells
      cell.Interior.TintAndShade = cell.Interior.TintAndShade - Darken
    Next cell
  Else '(Handle Shapes)
    With Selection
      .Interior.TintAndShade = .Interior.TintAndShade - Darken
    End With
  End If
    
End Sub

Solution 3: 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!