Interior Color as a function of Cell Contents

[Jared Call]

To All,

I've seen many ways to extract formatting data from cells, but I haven't
been able to figure a way to set the color based on cell values other than
Conditional Formatting. Conditional formatting only allows for three
colors, and I'm interested in 4 or more.

I'm guessing the solution lies with an If/Then statement with VBS, but
that's not something I'm yet familiar with.

Thanks!

Jared

 

[macropod]

Hi Jared,

Here's some vba to get you started.

If you put the code into the relevant worksheet's module, it will apply
coloured backgrounds for various conditions across E5:O25.

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Row > 4 And .Row < 26 And .Column > 4 And .Column < 16 Then
Select Case .Value
Case 0 To 5.035
.Interior.ColorIndex = 4
Case 5.036 To 10.21
.Interior.ColorIndex = 5
Case 10.211 To 15
.Interior.ColorIndex = 6
Case Is < 0
.Interior.ColorIndex = 7
Case Is >=15.001
.Interior.ColorIndex = 33
Case Else
.Interior.ColorIndex = 0
End Select
End If
End With
End Sub

Modify to suit your needs.

Cheers

 

[Jared Call]

Thanks for the reply macropod,

From that reply, I'm already a lot smarter on how to do this, and of course,
it's raised a few more questions.

What triggers the code to execute? When I left it as 'Worksheet Change' I
didn't see any colors changing. Then I played around, and put the code
under 'Selection Change' which causes color changes after a cell is
selected. I was hoping it would work under 'Calculate' but it didn't.
Ideally the change would take place when the worksheet is opened, or as soon
as a case is satisfied. Is there a different when adding this code to the
Module vs. the Worksheet? I'm sure I'm doing something wrong here.

The cases you've chosen look quite easy to modify where the cell itself
determines a case. How can I evaluate one cell in a row, and then affect
all the others in the same row as a result? (i.e. All the rows with the
word periapsis anywhere in the first column, or any cell of the current row,
would cause a change for the whole row. Since my only experience is with
functions, I'm still trying to think along those lines...

Case FIND("PERIAPSIS",C1)=TRUE
.Row.Interior.ColorIndex=3
Case FIND("APOAPSIS",C1)=TRUE
.Row.Interior.ColorIndex=4
Case FIND("RISE",C1)=TRUE
.Row.Interior.ColorIndex=5
Case FIND("SET",C1)=TRUE
.Row.Interior.ColorIndex=6


I obviously still need to learn how to build the If Cases..

Thanks in advance for the help.

~Jared

 

[macropod]

Hi Jared,

The code is triggered by you entering a value in any cell in the target
range. It works for me as a 'Worksheet Change' macro - on a PC. I don't own
a Mac, so I can't test it in that environment, but I would expect it to
function just the same.

To affect other cells, you could incorporate an Offset into the code, along
the lines of:
Selection.Offset(5, 1).Interior.ColorIndex = 42
or
Range("NamedRange").Interior.ColorIndex = 42
or even
Selection.EntireRow.Interior.ColorIndex = 42

An equivalent SheetCalculate macro, which you'd put into the Workbook module
and is triggered by any recalculation, might be:

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim i As Integer
Dim j As Integer
With ThisWorkbook.Sheets(1)
For i = 5 To 25
For j = 5 To 15
With Cells(i, j)
Select Case .Value
Case 0 To 5.035
Range("NamedRange").Interior.ColorIndex = 4
Case 5.036 To 10.21
.Interior.ColorIndex = 5
Case 10.211 To 15
.Interior.ColorIndex = 6
Case Is < 0
.Interior.ColorIndex = 7
Case Is >= 15.001
.Interior.ColorIndex = 33
Case Else
.Interior.ColorIndex = 0
End Select
End With
Next
Next
End With
End Sub

Note: you can't simply run these from a normal module, you must use the
Workbook module for 'Workbook_SheetCalculate' and the relevant Worksheet
module for 'Worksheet_Change'. You could, however, put any shared code into
a normal module and have the code in the Workbook and Worksheet modules call
that.

Cheers