More than 3 conditional formats

[Special-K]

Projects.xls
	P	Q	R	S
5	FUTURE	.	NONE
6	ONSCHEDULE	.	LOW
7	POSTPONED	.	MEDIUM
8	COMPLETED	.	HIGH
GROUP

I've tried several examples of how to go about using more than 3 conditional formats. Of the many I went through I cannot adapt them to get them to work for me. I would like a solution in VB that's easy to follow and change for my future expiriments ... if possible.

In the Example above ... I have a list in P5 - P8. If any of these same words are typed into COLUMN "Q" then I would like them formatted with the same colors, etc as shown in COLUMN "P"

It seems simple enough ... but I don't know VBA. And all the examples I've found and tried have failed.

Can somebody please help me here?
Many thanks!
k.

 

[Tom Urtis]

For the worksheet where this is happening, right click on that sheet tab, left click on View Code, and paste the following procedure into the large white area that is the worksheet module. Press Alt+Q to return to the worksheet.




Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 17 Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Target.Interior.ColorIndex = 0
Dim varFind As Variant
Set varFind = Columns(16).Find(What:=Target.Value, LookIn:=xlFormulas, LookAt:=xlWhole)
If varFind Is Nothing Then
Target.Interior.ColorIndex = 0
Else
Target.Interior.ColorIndex = Cells(varFind.Row, 16).Interior.ColorIndex
End If
End Sub

 

[Mel Smith]

Does this help? - Change the range and colours to suit.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim clr As Variant

' if the changed cell is not within "your range", do not run macro
If Intersect(Sh.["your range"], Target) Is Nothing Then Exit Sub

Application.EnableEvents = False

Select Case Target
Case Is = "Your text1" ' if the cell contains this value
clr = 3 ' set the colorindex to red
Case Is = "your text2"
clr = 36 ' light yellow
Case Is = "your text3"
clr = 35 ' light green
Case Is = "your text4"
clr = 34 ' light turquoise
Case Else 'if the value of the cell is not any of the above
clr = xlNone ' no color
End Select

' change the color of the cell accordingly
Target.Interior.ColorIndex = clr

Application.EnableEvents = True

End Sub


Mel

 

[Special-K]

Great! Thanks

Thanks!

 

[Special-K]

More advice please ...

Projects.xls
	P	Q	R	S
4
5	ONSCHEDULE	NONE
6	FUTURE	LOW
7	POSTPONED	MEDIUM
8	COMPLETED	HIGH
9	CANCELLED	CRITICAL
GROUP

I'm using the code below to "color code" a drop down list in COLUMN B (using the list values shown in COLUMN P (shown in the image) ... and it works great!

But I would also like to add another color coded drop down list in COLUMN I using the list values shown in COLUMN Q.

I know nothing about VB and was wondering if somebody can tell me how to edit the code below to do what I would like? Or is it not possible?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("E4:E50,F4:F50"), Target) Is Nothing Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub

Thanks for all the help!

 

[Special-K]

Oops ... correction

Shoot ... I posted the wrong code. Sorry about that.
The code I'm using is as follows:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Target.Interior.ColorIndex = 0
Dim varFind As Variant
Set varFind = Columns(16).Find(What:=Target.Value, LookIn:=xlFormulas, LookAt:=xlWhole)
If varFind Is Nothing Then
Target.Interior.ColorIndex = 0
Else
Target.Interior.ColorIndex = Cells(varFind.Row, 16).Interior.ColorIndex
End If
End Sub

 

[mrxwhite]

Does this help? - Change the range and colours to suit.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim clr As Variant

' if the changed cell is not within "your range", do not run macro
If Intersect(Sh.["your range"], Target) Is Nothing Then Exit Sub

Application.EnableEvents = False

Select Case Target
Case Is = "Your text1" ' if the cell contains this value
clr = 3 ' set the colorindex to red
Case Is = "your text2"
clr = 36 ' light yellow
Case Is = "your text3"
clr = 35 ' light green
Case Is = "your text4"
clr = 34 ' light turquoise
Case Else 'if the value of the cell is not any of the above
clr = xlNone ' no color
End Select

' change the color of the cell accordingly
Target.Interior.ColorIndex = clr

Application.EnableEvents = True

End Sub


Mel

This is great - exactly what I was looking for too - thanks! One question, any idea how to stop the code crashing if you copy/paste or delete rows/columns?

Thanks again
Mark