Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Conditional Format based on cell value

Status
Not open for further replies.

proteome

Technical User
May 14, 2003
115
US
I would like to change the cell background in a excel spreadsheet based on values within the individual cells. The best way I believe to do this is to use VBA since I have more than three conditions. I do not want to have to type the values into the cells again for the code to work which is what i currently have working I would like to have the worksheet automatically update. Like a macro running. Does anyone have any ideas.

Code:
Sub PrettyColors(ByVal Target As Range)
Dim icolor As Integer
If Not Intersect(Target, Range("A2:E1334")) Is Nothing Then
        With Target
            Select Case .Value
                Case 0 To 10
                    icolor = 6
                Case 11 To 20
                    icolor = 7
                Case 21 To 30
                    icolor = 8
                Case 31 To 40
                    icolor = 9
                Case 41 To 50
                    icolor = 10
                Case 51 To 60
                    icolor = 11
                Case 61 To 70
                    icolor = 12
                Case 71 To 80
                    icolor = 13
                Case 81 To 90
                    icolor = 14
                Case 91 To 100
                    icolor = 15
                Case Else
                    'Whatever
            End Select
        End With
        Target.Interior.ColorIndex = icolor
    End If
End Sub
 


NO TARGET
Code:
Private Sub Worksheet_Calculate()
...

Skip,
[sub]
[glasses] [red]A palindrome gone wrong?[/red]
A man, a plan, a ROOT canal...
PULLEMALL![tongue][/sub]
 
again at the risk of me sounding stupid... Help me understand what you mean by "TARGET"...
 
You posted
Code:
Private Sub Worksheet_Calculate([s]ByVal Target As Range[/s])

....
the Worksheet_Calculate event has no TARGET as an argument.

Skip,
[sub]
[glasses] [red]A palindrome gone wrong?[/red]
A man, a plan, a ROOT canal...
PULLEMALL![tongue][/sub]
 
Hi Mercwonder007

I have been creating a multiple conditional formatting procedure over the past few months

The basics of it are below which is courtesy of another user from another excel vb website. I'm currently creating an excel add-in to house this in so that you can do more complex formattings but keep it user friendly.

Anyway, here's the basic code. it even goes white / blank when you don't have any value in it.

------------------------------

Sub CheckCells()
If ActiveWorkbook.Name = "Book2.xls" Then
Set RangeToFormat = Sheets("Sheet1").Range("B2:B24")
For Each cell In RangeToFormat
With cell
' Empty cells
If IsEmpty(cell) Then
.Interior.ColorIndex = xlNone
' Numeric cells
ElseIf IsNumeric(cell.Value) Then
Select Case cell.Value
Case Is < 0
.Interior.Color = vbGreen
Case 0
.Interior.Color = vbYellow
Case Is > 0
.Interior.Color = vbMagenta
End Select
' Error cells
ElseIf IsError(cell.Value) Then 'Error cells
.Interior.Color = vbRed
' Other cells (text)
Else
.Interior.ColorIndex = xlNone
End If
End With
Next cell
End If
'· You need to change the cell reference as needed (currently set to operate on cells B7:F17).
'· You need to put a "dummy function" somewhere in the sheet to cause this to execute. Put something like =SUM(B7:F17) in some obscure cell.
'· Then save the file, reopen it, and it should work.

'Change and/or add Case statements as needed. For help on format of Case statements, place the pointer over the word Case (in the VBA editor) and hit the F1 key.
End Sub

------------------------

you then also need this calculate() sub routine which you need to copy and paste into the same worksheet code-sheet.

Private Sub Worksheet_Calculate()

Me.OnCalculate = ActiveSheet.Name & ".CheckCells"

End Sub

---------------------------

Hope this helps

RodP
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top