Colour by code in Excel with VBA - Part 3

By John — in arrows, category, cell background rgb, color macro, colour, colour macro, copy colour excel vba html, list color, vba color · 4 min read
Colour by code in Excel with VBA - Part 3

Following on from the previous entries  ( * see page list )  , in this post, we'll be looking at a few more methods to colour ranges / cells to achieve easy visual categorisation.

Here's a few quick scripts / examples that you can use in your own projects.

These are as usual intended to help learn / use as a basis for your own scripts. 

Example 1  - Using the user selected ( Ribbon ) colours in a Sub

You've probably wondered why this isn't exposed as a Variable / Method to be able to access as you would with any other object in Excel, and as yet ( July 2020 ) , I can't find any official documentation a to why.

Up in the 'Home' section of the Ribbon, you have the two handy swatches,  Fill Colour and Font Colour respectively.   
 Colour Swatches on RibbonWouldn't it be useful to be able to access these, rather than having to use a colour picker on your scripts?

 Have a look at the script below - this one method of getting those colours into a usable form.



Sub GetWorkbookUserColoursExample()

Dim LP As Integer, ColFG, ColBG As Long
Dim FL_IND, FL_IND_NEG As Double
Dim F_R, F_G, F_B, B_R, B_G, B_B As Integer
Dim IterationsMax As Integer

IterationsMax = 40

Range("A1").Select

Application.CommandBars.ExecuteMso ("CellFillColorPicker")

Range("A2").Select

Application.CommandBars.ExecuteMso ("FontColorPicker")

':: Set font to background colour so we can see it.
Range("A2").Interior.Color = Range("A2").Font.Color

':: Store to variables.

ColFG = Range("A2").Interior.Color
ColBG = Range("A1").Interior.Color

'STORE AS COLOUR COMPONENTS ::
':: FOREGROUND
'R
F_R = ColFG Mod 256
'G
F_G = ((ColFG \ 256) Mod 256)
'B
F_B = (ColFG \ 65536)
':: BACKGROUND
'R
B_R = ColBG Mod 256
'G
B_G = ((ColBG \ 256) Mod 256)
'B
B_B = (ColBG \ 65536)




':: Do a Gradient? ?

     
     
     
For LP = 0 To IterationsMax
':: Set factor 0-1 to apply to individual R/G/B components of Forground / Background Colours..
    
    FL_IND = LP / IterationsMax
    FL_IND_NEG = (IterationsMax - LP) / IterationsMax
    Range("C" & LP + 1).FormulaR1C1 = "FG: " & Format(FL_IND, "#0%") & " / BG: " & Format(FL_IND_NEG, "#0%")

Range("D" & LP + 1).Interior.Color = RGB(CInt(FL_IND * F_R), CInt(FL_IND * F_G), CInt(FL_IND * F_B))

Range("E" & LP + 1).Interior.Color = RGB(CInt(FL_IND_NEG * B_R), CInt(FL_IND_NEG * B_G), CInt(FL_IND_NEG * B_B))

Range("F" & LP + 1).Interior.Color = RGB(CInt(FL_IND_NEG * B_R) + CInt(FL_IND * F_R), CInt(FL_IND_NEG * B_G) + CInt(FL_IND * F_G), CInt(FL_IND_NEG * B_B) + CInt(FL_IND * F_B))

Next LP

End Sub

 I just threw in the gradient part there as one method of using the colours.

The useful part is the two lines 

Application.CommandBars.ExecuteMso ("CellFillColorPicker")
Application.CommandBars.ExecuteMso ("FontColorPicker")

These methods essentially act like you clicked the swatches and applies the colour ( font or fill ) to the selected cell.   

To then capture these, simply access/save the cell colour to a variable. 

A simpler example - 


':: Select the range 
Range("A2").Select
':: Do the ExecuteMSO  ( Set Cell Background/Fill colour )
Application.CommandBars.ExecuteMso ("CellFillColorPicker")
':: Store to variables.
MyBgColourVariable = Range("A2").Interior.Color

Maybe one day, we'll be able to reference  it via the Workbook / Application as something like Workbook.Swatch.FillColor or something.

As of now, this is the most reliable method I've found.

Example 2  - Sum or Count by colour in range. 

Since this is a user defined function, you may need to hit F9 to get it to update, since Excel won't typically auto-calc.
Excel Gant Calendar chart

 The code checks for instances in the referenced range that match its cell's colour, and returns either a sum or a count based on that.   Years ago I used something similar for tracking holiday in an excel calendar.  Again, this may not be that efficient for performance etc, but may be useful to someone somewhere, particularly prototyping or simpler sheets like the above example, where it's only a handful of cells. 



Function GetColourSum(MyRange As Range, Optional FontOrBG As Boolean) As Double

Dim MyColour As Long

MyColour = Application.ThisCell.Interior.Color

Dim MyCell As Range

If IsMissing(FontOrBG) Then FontOrBG = False

For Each MyCell In MyRange

    If FontOrBG = False And MyCell.Interior.Color = MyColour And IsNumeric(MyCell.Value) Then
        GetColourSum = GetColourSum + CDbl(MyCell.Value)
    End If

    If FontOrBG And MyCell.Font.Color = MyColour And IsNumeric(MyCell.Value) Then
        GetColourSum = GetColourSum + CDbl(MyCell.Value)
    End If

Next MyCell



End Function



Function GetColourCount(MyRange As Range, Optional FontOrBG As Boolean) As Long

Dim MyColour As Long
MyColour = Application.ThisCell.Interior.Color

Dim MyCell As Range

If IsMissing(FontOrBG) Then FontOrBG = False

Debug.Print "FontOrBG  IS  : " & FontOrBG


For Each MyCell In MyRange

    If FontOrBG = False And MyCell.Interior.Color = MyColour Then
        GetColourCount = GetColourCount + 1
    End If
    
    If FontOrBG And MyCell.Font.Color = MyColour Then
        GetColourCount = GetColourCount + 1
    End If

Next MyCell

End Function

 

 

 

 

 

Tagged as arrows, category, cell background rgb, color macro, colour, colour macro, copy colour excel vba html, list color and vba color

John —

Started out in media/graphic design then moved to Financial Services / MI data / Business intelligence. ~15 years experience of Excel / VBA , and more recently Qliksense , SQL

  • [CONTACT]
  • [LOCATION]
    London, UK