Option Compare Text
Sub colorit()
For Each cell In ActiveSheet.UsedRange
With cell
Select Case .Value
Case Is = "West"
..Font.Bold = True
..Interior.ColorIndex = 3
Case Is = "East"
..Font.Bold = True
..Interior.ColorIndex = 5
Case Is = "North"
..Font.Bold = True
..Interior.ColorIndex = 4
Case Is = "Central"
..Font.Bold = True
..Interior.ColorIndex = 6
Case Else
..Font.Bold = False
..Interior.ColorIndex = 0
End Select
End With
Next
End Sub


Gord

On Thu, 25 Dec 2008 09:40:01 -0800, Bob
wrote:

The code works great if I retype the name in the cell. The sheet is already
filled out, is there a way to auto update with out retyping every name in the
column over?

"mikeaj72" wrote:


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
With Target
Select Case .Value
Case Is = "West"
.Font.Bold = True
.Interior.ColorIndex = 3
Case Is = "East"
.Font.Bold = True
.Interior.ColorIndex = 5
Case Is = "North"
.Font.Bold = True
.Interior.ColorIndex = 4
Case Is = "Central"
.Font.Bold = True
.Interior.ColorIndex = 6
Case Else
.Font.Bold = False
.Interior.ColorIndex = 0
End Select
End With
End If
End Sub


--
mikeaj72
------------------------------------------------------------------------
mikeaj72's Profile: http://www.thecodecage.com/forumz/member.php?userid=46
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=44176