VBA code for 5-rule Conditional Formating

[Antonio]

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

 

[Bob Phillips]

'-----------------------------------------------------------------
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)

 

[JW]

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

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]

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

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
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

 

[Rick Rothstein \(MVP - VB\)]

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]

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]

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]

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]

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.







- 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]

'-----------------------------------------------------------------
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)

 

[IanKR]

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.

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.