Applying changing cells colour with different two cases of statement

[ims121uk]

Hi All,

Is there anyone that can help me please on changing cells colour with a
case method for alternative columns.

For example

A1:A10 = Would have this case method

Case Is = 0: Num = 3 'red
Case Is = 1: Num = 3 'red
Case Is = 2: Num = 46 'Amber
Case Is = 3: Num = 46 'Amber
Case Is = 4: Num = 43 'green
Case Is = 5: Num = 43 'green

While

B1:B10 = Would have this case method

Case Is = 0: Num = 3 'red
Case Is = 1: Num = 3 'red
Case Is = 2: Num = 46 'Amber
Case Is = 3: Num = 43 'green
Case Is = 4: Num = 43 'green
Case Is = 5: Num = 43 'green

many thanks

Imran

 

[Bob Phillips]

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("A1:A10")) Is Nothing Then
With Target
Select Case .Value
Case Is = 0: Interior.ColorIndex = 3 'red
Case Is = 1: Interior.ColorIndex = 3 'red
Case Is = 2: Interior.ColorIndex = 46 'Amber
Case Is = 3: Interior.ColorIndex = 46 'Amber
Case Is = 4: Interior.ColorIndex = 43 'green
Case Is = 5: Interior.ColorIndex = 43 'green
End Select
End With
ElseIf Not Intersect(Target, Me.Range("B1:B10")) Is Nothing Then
With Target
Select Case .Value
Case Is = 0: Interior.ColorIndex = 3 'red
Case Is = 1: Interior.ColorIndex = 3 'red
Case Is = 2: Interior.ColorIndex = 46 'Amber
Case Is = 3: Interior.ColorIndex = 43 'green
Case Is = 4: Interior.ColorIndex = 43 'green
Case Is = 5: Interior.ColorIndex = 43 'green
End Select
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 Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[NickHK]

Here's one way, but you could achieve it with conditional formatting.

Dim Num As Long

Select Case True
Case Not Intersect(Target, Range("A1:A10")) Is Nothing
Select Case Target.Value
Case 0, 1: Num = 3 'red
Case 2, 3: Num = 46 'Amber
Case 4, 5: Num = 43 'green
End Select
Case Not Intersect(Target, Range("B1:B10")) Is Nothing
Select Case Target.Value
Case 0, 1: Num = 3 'red
Case 2: Num = 46 'Amber
Case 3, 4, 5: Num = 43 'green
End Select
Case Else
'Do nothing
Exit Sub
End Select

Target.Interior.ColorIndex = Num

NickHK

 

[ims121uk]

many thanks for both of your help.

Here's one way, but you could achieve it with conditional formatting.

Dim Num As Long

Select Case True
Case Not Intersect(Target, Range("A1:A10")) Is Nothing
Select Case Target.Value
Case 0, 1: Num = 3 'red
Case 2, 3: Num = 46 'Amber
Case 4, 5: Num = 43 'green
End Select
Case Not Intersect(Target, Range("B1:B10")) Is Nothing
Select Case Target.Value
Case 0, 1: Num = 3 'red
Case 2: Num = 46 'Amber
Case 3, 4, 5: Num = 43 'green
End Select
Case Else
'Do nothing
Exit Sub
End Select

Target.Interior.ColorIndex = Num

NickHK