DRJ's conditional formatting

[toniminbikfa]

Hi, I came across DRJ's vba code for more than 3 conditional formatting while doing a search and am having a little bit of trouble custom-tailoring it to my need. The code works great for the entire sheet, but what I would like to do is make it work for only one column (the entire AI column). Is there a way to modify it so that it works for only that one column and nowhere else on the worksheet? I am using Excel 2000. I appreciate any help. Here is the code for reference:

Option Compare Text 'A=a, B=b, ... Z=z
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
Dim Rng1 As Range

On Error Resume Next
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
On Error Goto 0
If Rng1 Is Nothing Then
Set Rng1 = Range(Target.Address)
Else
Set Rng1 = Union(Range(Target.Address), Rng1)
End If
For Each Cell In Rng1
Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case "Tom", "Joe", "Paul"
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = True
Case "Smith", "Jones"
Cell.Interior.ColorIndex = 4
Cell.Font.Bold = True
Case 1, 3, 7, 9
Cell.Interior.ColorIndex = 5
Cell.Font.Bold = True
Case 10 To 25
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = True
Case 26 To 99
Cell.Interior.ColorIndex = 7
Cell.Font.Bold = True
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next

End Sub

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
Dim Rng1 As Range

On Error Resume Next
Set Rng1 = Me.Columns("AI:AI").SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0
If Rng1 Is Nothing Then
Set Rng1 = Range(Target.Address)
Else
Set Rng1 = Union(Range(Target.Address), Rng1)
End If
For Each Cell In Rng1
Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case "Tom", "Joe", "Paul"
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = True
Case "Smith", "Jones"
Cell.Interior.ColorIndex = 4
Cell.Font.Bold = True
Case 1, 3, 7, 9
Cell.Interior.ColorIndex = 5
Cell.Font.Bold = True
Case 10 To 25
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = True
Case 26 To 99
Cell.Interior.ColorIndex = 7
Cell.Font.Bold = True
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next

End Sub

[MikeO]

Option Compare Text 'A=a, B=b, ... Z=z
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim Rng1 As Range
On Error Resume Next
Set Rng1 = ActiveSheet.Range("AI:AI").SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0
If Rng1 Is Nothing Then
Exit Sub
End If
For Each Cell In Rng1
Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case "Tom", "Joe", "Paul"
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = True
Case "Smith", "Jones"
Cell.Interior.ColorIndex = 4
Cell.Font.Bold = True
Case 1, 3, 7, 9
Cell.Interior.ColorIndex = 5
Cell.Font.Bold = True
Case 10 To 25
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = True
Case 26 To 99
Cell.Interior.ColorIndex = 7
Cell.Font.Bold = True
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next
End Sub

[toniminbikfa]

Thanks guys, but neither of those codes are working properly. xld, your code still highlights cases all over the worksheet and MikeO, your code doesnt highlight cases anywhere on the worksheet...

[Bob Phillips]

Perhaps this



Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
Dim Rng1 As Range

If Not Intersect(Target, Me.Range("AI:AI")) Is Nothing Then

Set Rng1 = Me.Range("AI1").Resize(Me.Cells(Me.Rows.Count, "AI").End(xlUp).Row)
For Each Cell In Rng1.Cells
Select Case Cell.Value
Case "Tom", "Joe", "Paul"
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = True
Case "Smith", "Jones"
Cell.Interior.ColorIndex = 4
Cell.Font.Bold = True
Case 1, 3, 7, 9
Cell.Interior.ColorIndex = 5
Cell.Font.Bold = True
Case 10 To 25
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = True
Case 26 To 99
Cell.Interior.ColorIndex = 7
Cell.Font.Bold = True
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next
End If

End Sub

[toniminbikfa]

I have tried a similar code but am having the same issues with this new code you have posted, xld. My question to you now is, is there a way to automatically remove the highlighting after the cell has been cleared? For instance, if I enter "Tom" into cell AI1, it turns the cell red, but when I delete "Tom" from the cell, the cell remains red. Is there a way for it to revert back to white?

[Bob Phillips]

It clears down to no colour here, just as you want.

[JimmyTheHand]

It clears down to no colour, when Column AI is not empty.
If there is only one "Tom" somewhere, when deleted, the empty cell remains red.
(Sorry, no time to come up with a solution right now.)

[Bob Phillips]

Is it a formula in AI, and the other cell being cleared, because I don't get any such behaviour if the values are in AI.

[JimmyTheHand]

I think the problem lies with this:
Set Rng1 = Me.Range("AI1").Resize(Me.Cells(Me.Rows.Count, "AI").End(xlUp).Row) The above expression returns a range that doesn't include anything below the last value in column AI. Thus, if you delete the bottommost values, their cells are excluded from further processing, and so they remain coloured.

Having no better idea I suggest using this expression instead:
Set Rng1 = Intersect(Me.Range("AI:AI"), Me.UsedRange) because UsedRange, though not very well defined, surely includes all coloured cells, even if they contain no value.

Jimmy

[toniminbikfa]

Thanks for the help guys. Jimmy, your modification didnt work, but I appreciate your help anyways. xld, your code actually works quite well and I am using it happily :) I was just being a little picky with the color thing, but it does revert back to white when another field is entered. Thanks for everyone's help!

[Bob Phillips]

If you can explain to me what is not happening, I am sure I can fix it. It is just that with my setup I cannot reproduce it.