PDA

View Full Version : Colour Cell background based on cell values



Rem0ram
09-04-2014, 07:04 AM
Hi

This is a query already posted in another thread, any advise will be helpful



http://www.excelforum.com/excel-programming-vba-macros/1035028-colour-cell-background-based-on-cell-values.html




(http://www.excelforum.com/excel-programming-vba-macros/1035028-colour-cell-background-based-on-cell-values.html)

SamT
09-04-2014, 05:27 PM
Link to file at ExcelForum: File (http://www.excelforum.com/attachments/excel-programming-vba-macros/343152d1409822972-colour-cell-background-based-on-cell-values-cval.xls)

I leave you to discover which ColorIndex numbers are the ones you want. Hint' For each Cel in Range, where Range values are 1 to 56, set the color to the Range's value


Option Explicit

Sub CellColor()

Const Black As Long = 1
Const Red As Long = 3
Const Yellow As Long = 4 'Adjust to fit
Const Amber As Long = 5 'Adjust to fit

Dim Cel As Range
Dim LastRow As Long
LastRow = Cells(Rows.Count, 8).End(xlUp).Row

For Each Cel In Range("H2:H" & CStr(LastRow))
If IsError(Cel.Value) Then GoTo AfterSelect
Select Case Cel.Value
Case Is > 1
Cel.Interior.ColorIndex = Red
Case Is > 0.9
Cel.Interior.ColorIndex = Amber
Case Is > 0.85
Cel.Interior.ColorIndex = Yellow
Case Is < 0
Cel.Interior.ColorIndex = Black
Case Else
End Select
AfterSelect:
Next Cel
End Sub

If this solves your problem, use the Tread Tools at the top to mark this thread Solved, then go back to your thread on ExcelForum, post this code and mark that thread solved, so readers there can find the solution.

Rem0ram
09-05-2014, 07:31 AM
Hi SamT

Thanks for the code, however when I run them in my workbook it altogether updates with different colour.

for values between 0.85 and 100 it updates blue colour

Rem0ram
09-05-2014, 07:51 AM
Hi SamT

Its working fine now.

Thanks

SamT
09-05-2014, 12:08 PM
:thumb

Rem0ram
09-08-2014, 07:26 AM
Hi SamT

Thanks for the solution.

Now I face a new challenge here, for those cases i want to check the range for colouring the cell.


Const Black As Long = 1
Const Red As Long = 3
Const Yellow As Long = 6 'Adjust to fit
Const Amber As Long = 45 'Adjust to fit

Dim Cel As Range
Dim LastRow As Long
LastRow = Cells(Rows.Count, 8).End(xlUp).Row

For Each Cel In Range("H2:H" & CStr(LastRow))
If IsError(Cel.Value) Then GoTo AfterSelect
Select Case Cel.Value
Case Is >= 0.999
Cel.Interior.ColorIndex = Red
Case Is > 0.901 To <= 0.9945
Cel.Interior.ColorIndex = Amber
Case Is >= 0.845 To <= 0.9945
Cel.Interior.ColorIndex = Yellow
Case Is < 0
Cel.Interior.ColorIndex = Black
Cel.Font.ColorIndex = 2
Case Else
End Select
AfterSelect:
Next Cel

If you could advise how to resolve that would be helpful.

SamT
09-08-2014, 09:01 AM
Now I face a new challenge here, for those cases i want to check the range for colouring the cell.
I don't understand.

However I see a problem in that Select Case function. Since Excel calculates values to (IIRC) 32 places, but only displays values according to formatting rules, you have left gaps in the coverage by using Case m To n with only 4 significant digits.

The solution: When any given Case is met, the execution leaves the Select Case before the next Case. Just use Case >= 0.mmm in all Cases.

Case Else will be met by Cel.Value = 0.

The If IsError() line is needed because the Value of Errors can be >= 1.

I am guessing about your challenge, but would not that same Sub work by only changing the Select case to
Select Case Cel.Interior.ColorIndex

Rem0ram
09-08-2014, 10:12 AM
Hi SamT

Not sure what your suggestion in the last line.

I have managed to make it work the way i wanted as below.


Const Black As Long = 1
Const Red As Long = 3
Const Yellow As Long = 6 'Adjust to fit
Const Amber As Long = 45 'Adjust to fit

Dim Cel As Range
Dim LastRow As Long
LastRow = Cells(Rows.Count, 8).End(xlUp).Row

For Each Cel In Range("H2:H" & CStr(LastRow))
If IsError(Cel.Value) Then GoTo AfterSelect
Select Case Cel.Value
Case Is >= 0.995
Cel.Interior.ColorIndex = Red
Case 0.895 To 0.9949
Cel.Interior.ColorIndex = Amber
Case 0.845 To 0.8949
Cel.Interior.ColorIndex = Yellow
Case Is < 0
Cel.Interior.ColorIndex = Black
Cel.Font.ColorIndex = 2
Case Else
End Select
AfterSelect:
Next Cel

But still im concerned there might be hidden bomb.

SamT
09-08-2014, 02:17 PM
you are not sure about my suggestion, because I am not sure about your challenge.

I see the possibility of a lot of hidden bombs in there. What happens if the actual Cel.Value is 0.99495

If you use this version, there will be no "significant digit" bombs, but the code works the same as yours.

Select Case Cel.Value
Case Is >= 0.995
Cel.Interior.ColorIndex = Red
Case Is >=0.895
Cel.Interior.ColorIndex = Amber
Case Is >=0.845
Cel.Interior.ColorIndex = Yellow
Case Is > 0
'Not needed at this time. Do Nothing
Case Is <= 0
Cel.Interior.ColorIndex = Black
Cel.Font.ColorIndex = 2
Case Else

Notice how the Cases are descending in value. That is why this works the same as yours.

Rem0ram
09-09-2014, 06:56 AM
Hi SamT

Thanks will check on your input.