Colour by code in Excel with VBA - Part 1
- 0 0
Want a quick way to highlight cells by their content ? Read on!
As of the writing of this article, Excel doesn't have much by way of separating out text fields by colour, despite having had a variety of numeric gradient formatting for a number of years.
All colours on screens are made of RGB pixels , from this you can mix any colour you like:
For example - Cyan is a mixture of Green and Blue, Purple a mixture of Red and blue, Grey is an even mix of all colours.
You can read up on it here : https://en.wikipedia.org/wiki/RGB_color_model
We can use these components and conditionally mix them to create our background colours.
The next thing we need to know, is that every letter in the alphabet has a corresponding number - this is called an ASCII code. In the standard ASCII set there are 255 characters, which includes, numbers, letters, punctuation and special non-printing characters.
RGB colour in Excel is stored as a range of 0-255 for each 'pot' - if we just take the first, middle and last character from a string, and turn it into a colour, we get the below :
It works, but the colours are very dull. Clearly converting straight from ASCII to RGB isn't going to work.
So what now?
We just need to be smarter about how we're applying the numbers.
In the standard ASCII set , the 26 Uppercase, 26 Lowercase and 10 numbers only a quarter of the possible ASCII codes, and represent a limited range, therefore we're not getting sufficient variance from simply applying them directly to a colour mix.
Instead what we need to do, is sort them into sets ( Upper, Lower and Numeric ) , from there, we can determine set upper and lower boundaries for that set, and with that fixed, we can calculate a generic position within that ranger, and return a value between 0 and 1.
First, what are the bounds?
So we have uppercase, running from 65 - 90 , lower from 97 -122 and numeric from 48-57 .
Our first function - lets take the character as an input, then return a float of range of 0-1 depending on which category it falls in ( Upper, Lower or Numeric ) .
Here's the output - side by side with the original- already the colours are looking more defined.
Here's the code to return the factor float based on the cell text :
Function Alpha_Fact(INSTRE As String) As Double Dim AscNum As Integer, RtnNum As Double 'UPPER CASE 65 90 26 'NUMERIC 48 57 10 'LOWER CASE 97 122 26 If Len(INSTRE) < 1 Then INSTRE = "AMZ" AscNum = Asc(Left(INSTRE, 1)) Select Case AscNum ' ::: UPPER ::::::: Case 65 To 90 RtnNum = (AscNum - 64) / 26 ' ::: LOWER ::::::::::: Case 97 To 122 RtnNum = (AscNum - 96) / 26 ' ::: NUMERIC ::::::::::::::: Case 48 To 57 RtnNum = (AscNum - 47) / 10 ' ::: OTHER :::::::::::::::::::::: Case Else: RtnNum = Int((AscNum / 255) * 250) / 250 End Select Alpha_Fact = RtnNum
In the below chart - just looking at the first half of the ASCII range, you can see how it works :
Where it fits within a bracket ( upper / lower / numeric ) it returns 0-1 relative to that bracket, else it'll return 0-1 based on it's overall position in the range of 0-255.
Putting it all together
Now we have our conditional range - its' now time to put it into a procedure to apply to ranges.
Sub ColourByText() Dim Rr As Range, Cc As Range, DD As Range, cR, cG, cB As Double, CstrB As String Dim Rnt, Gnt, Bnt As Double Dim STL, STM, STR As String Dim StrString As String Dim MaxHue As Single, MaxRow As Long Dim bSpecial As Boolean Set Rr = Selection bSpecial = False For Each DD In Rr.Areas MaxRow = Last(1, DD) 'MsgBox DD.Rows.count & "Max Row :" & MaxRow For Each Cc In DD bSpecial = False If Cc.Row > MaxRow Then Exit For StrString = Cc.text If StrString <> "" Then StrString = Trim(StringCleanNPC(StrString)) STL = Left(StrString, 1) If Len(StrString) > 2 Then STM = Mid(StrString, Round(Len(Cc.text) / 2, 0), 1) Else: STM = STL End If STR = Right(StrString, 1) Rnt = Int(Alpha_Fact(Left(STM, 1)) * 96) Gnt = Int(Alpha_Fact(Left(STL, 1)) * 160) Bnt = Int(Alpha_Fact(Left(STR, 1)) * 96) ' ':: special cases :: ' Select Case UCase(StrString) Case "BREAK": Rnt = 254 Gnt = 184 Bnt = 156 bSpecial = True Case "MATCH": Rnt = 157 Gnt = 248 Bnt = 132 bSpecial = True Case "NO": Rnt = 254 Gnt = 184 Bnt = 156 bSpecial = True Case "YES": Rnt = 157 Gnt = 248 Bnt = 132 bSpecial = True Case "Y": Rnt = 254 Gnt = 184 Bnt = 156 bSpecial = True Case "N": Rnt = 157 Gnt = 248 Bnt = 132 bSpecial = True Case "---": Rnt = 180 Gnt = 180 Bnt = 220 bSpecial = True End Select '::: --Do nothing if empty - :: If Len(StrString) > 0 And bSpecial = False Then Cc.Interior.Color = RGB(140 + Rnt, 255 - Gnt, 140 + Bnt) If bSpecial Then Cc.Interior.Color = RGB(Rnt, Gnt, Bnt) End If Next Cc Next DD End Sub
In the above, it'll analyse the first, middle and last letter of cell to return the factor 0-1 , with a slight bias towards green.
There's also a conditional statement at the end, which, when specified, will assign a specific colour to a specific word, this is useful for generic columns with Y/N Yes/No True/False etc. ( Or names ) .
As an example of usage - here a quick currency char is spiced up by the automatic colours. Where it's based on content, and therefore deterministic - users will quickly be able to spot lines / items by colour ( for example, USD will always be Salmon coloured, GBP be Turquoise etc. )