Conditional Formatting

Posted by Kathi on April 16, 2001 12:43 PM

I am trying to format several different values in a column ( to a different font color) using conditional formatting. There seems to be a limit of three different values per coloumn, however. There are seven different names I am trying to get to have something in common so I can run the same formula on all of them. Does anyone know if there is a work around for this?

Posted by Bj on April 16, 2001 12:52 PM

This is a little long, I am sure someone has a shorter version, but it works!

Private Sub CommandButton1_Click()
Dim LastRow As Integer
Dim X As Integer

LastRow = Range("A65536").End(xlUp).Row
For X = 1 To LastRow

If Range("A" & X).Value = "Test1" Then
Range("A" & X).Select
With Selection.Font
.ColorIndex = 1
End With
End If

If Range("A" & X).Value = "Test2" Then
Range("A" & X).Select
With Selection.Font
.ColorIndex = 2
End With
End If

If Range("A" & X).Value = "Test3" Then
Range("A" & X).Select
With Selection.Font
.ColorIndex = 3
End With
End If

If Range("A" & X).Value = "Test4" Then
Range("A" & X).Select
With Selection.Font
.ColorIndex = 4
End With
End If

Next X
End Sub

Posted by Dave Hawley on April 16, 2001 2:20 PM

Hi Kathi

You could use the Sheet_Change event for this.
Right click on your sheet name tab and select "View Code" and paste in this.

Private Sub Worksheet_Change(ByVal Target As Range)
'Written by OzGrid Business Applications
'www.ozgrid.com

Dim WatcRange As Range

If Target.Cells.Count > 1 Then Exit Sub

If Target.Columns = 1 Then Set WatchRage = Range("A1:A10")

If Not Intersect(Target, WatchRange) Is Nothing Then
Select Case Target
Case 1 To 10
Target.Interior.ColorIndex = 6
Case 11 To 20
Target.Interior.ColorIndex = 3
Case Is > 20
Target.Interior.ColorIndex = 2
Case Else
Target.Interior.ColorIndex = 1
End Select
End If

Set WatchRange = Nothing
End Sub

Change the WatchRange to suit and add more Case statements etc. Then push Alt+Q and Save.

Dave

OzGrid Business Applications

Posted by Dave Hawley on April 16, 2001 3:19 PM

Oops typos!

Few typos in the other code, use this one instead!

Private Sub Worksheet_Change(ByVal Target As Range)
'Written by OzGrid Business Applications
'www.ozgrid.com

Dim WatchRange As Range

If Target.Cells.Count > 1 Then Exit Sub

If Target.Column = 1 Then Set WatchRange = Range("A1:A10")

Set WatchRange = Nothing
End Sub

OzGrid Business Applications

Posted by Dave Hawley on April 16, 2001 4:14 PM

Ok, I've had my coffee now :o) Ignore the other one!

Private Sub Worksheet_Change(ByVal Target As Range)
'Written by OzGrid Business Applications
'www.ozgrid.com

Dim WatchRange As Range

If Target.Cells.Count > 1 Then Exit Sub

If Target.Column = 1 Then
Set WatchRange = Range("A1:A10")

DaveOzGrid Business Applications