Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

VBA code for 5-rule Conditional Formating

13 views
Skip to first unread message

Antonio

unread,
May 28, 2008, 1:18:00 PM5/28/08
to
Would anyone have a VAb code for a macro that changes the color of a cell
according to 5 different rules? A2 would be black if A1=1, green if A1=2,
gray if A1=3, blue if A1=4 or gold if A1=5.
Thanks

JW

unread,
May 28, 2008, 1:40:58 PM5/28/08
to

Here's one way. Right click the sheet tab where you want this to
happen and select View Code. Paste the below code in there. Change
the Range("A2:A50") to whatever range you want the condition to apply.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim clr As Integer
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
Select Case Target
Case 1
clr = 1
Case 2
clr = 4
Case 3
clr = 15
Case 4
clr = 41
Case 5
clr = 44
Case Else
clr = -4142
End Select
Target.Offset(0, 1).Interior.ColorIndex = clr
End If
End Sub

JW

unread,
May 28, 2008, 1:42:35 PM5/28/08
to

typo on my part.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim clr As Integer

If Not Intersect(Target, Range("A2:A50")) Is Nothing Then

Bob Phillips

unread,
May 28, 2008, 1:38:52 PM5/28/08
to
'-----------------------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "A1" '<=== change to suit
Dim ci As Long

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
Select Case .Value
Case 0: ci = vbBlack
Case 1: ci = 10 'green
Case 2: ci = 15 'gray 25%
Case 3: ci = 5 'blue
Case 4: ci = 44 'gold
End Select
.Offset(1, 0).Interior.ColorIndex = ci
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

"Antonio" <Ant...@discussions.microsoft.com> wrote in message
news:BF0BC695-ACD5-4C40...@microsoft.com...

Rick Rothstein (MVP - VB)

unread,
May 28, 2008, 1:51:42 PM5/28/08
to
You could use this Worksheet Change event code...

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ClrInx As Long
Dim CellToChange As Range
If Target.Address = "$A$1" Then
ClrInx = Target.Value
Set CellToChange = Range("B3")
Select Case ClrInx
Case 1 To 5
CellToChange.Cells.Interior.ColorIndex = _
Array(1, 4, 15, 5, 12)(ClrInx)
Case Else
CellToChange.Cells.Interior.ColorIndex = xlNone
End Select
End If
End Sub

To implement it, right click the tab you want this functionality on, and
copy/paste the above code into the code window that appears. Two things you
have to modify above... first, change the CellToChange reference from the
example B3 I used to whatever cell address you want to change colors;
second, change the color index numbers I used inside the Array function call
to the color index numbers you actually want. If you are unsure what index
values to use, select a sheet where Column A is unused and run this code
directly in the Immediate window within the VB editor... find the colors you
want on the worksheet, the row number they are on is the color index number
you would use....

For x = 1 To 56: Cells(x, 1).Cells.Interior.ColorIndex = x: Next

Either clear or delete the column with the sample colors in it when
finished.

Rick


"Antonio" <Ant...@discussions.microsoft.com> wrote in message
news:BF0BC695-ACD5-4C40...@microsoft.com...

Antonio

unread,
May 29, 2008, 1:16:03 PM5/29/08
to
Thanks, but it didn't work.

The cell i'm referring tool contais anf if function, and it will change its
value (1,2,3,4 or 5) depending on the different conditions. The macro didn't
work. If I type the values, it works, but if i associate it to a function it
won't.

Antonio

unread,
May 29, 2008, 1:17:01 PM5/29/08
to
Thanks, JW, but the macro didn't work. It works if I type the values, but I
want them to be associated to an if function, that will attribute the values
1,2,3,4 or 5 based on different conditions.

Antonio

unread,
May 29, 2008, 1:25:01 PM5/29/08
to
Hi Bob, more specifically, if the cell is <=59 the cell itself becomes blue,
if it’s <=69 it becomes green, if it’s <=79 it becomes yellow, if it’s <=89
it becomes orange and if it’s <=100 it becomes black.

JW

unread,
May 29, 2008, 1:28:59 PM5/29/08
to
> > End Sub- Hide quoted text -
>
> - Show quoted text -

Use the Calculate event instead then

Private Sub Worksheet_Calculate()
Dim clr As Integer, r As Range
Dim CondRange As Range
Set CondRange = Range("A2:A50")
For Each r In CondRange
Select Case r.Value


Case 1
clr = 1
Case 2
clr = 4
Case 3
clr = 15
Case 4
clr = 41
Case 5
clr = 44
Case Else
clr = -4142
End Select

r.Offset(0, 1).Interior.ColorIndex = clr
Next r
End Sub

Bob Phillips

unread,
May 29, 2008, 2:21:27 PM5/29/08
to
'-----------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "A1" '<=== change to suit
Dim ci As Long

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
Select Case .Value

Case <=59: ci = 5 'blue
Case <=69: ci = 10 'green
Case <=79: ci = 6 'gold
Case <=80: ci = 46 'orange
Case <=100: ci = 1 'black


End Select
.Offset(1, 0).Interior.ColorIndex = ci
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

"Antonio" <Ant...@discussions.microsoft.com> wrote in message

news:E88F0F70-EB3C-496E...@microsoft.com...

IanKR

unread,
Jun 1, 2008, 7:19:53 PM6/1/08
to

As JW say above, put the code in the Worksheet_Calculate event instead. I've
come across this before; a change in a cell's value via a formula in that
cell being updated does not (in itself) fire the Worksheet_Change event, but
it does fire the Worksheet_Calculate event.

0 new messages