Private Sub Worksheet_Change(ByVal Target As Range)
Dim Num As Long
Dim rng As Range
Dim vRngInput As Variant
Set vRngInput = Intersect(Target,
Range("B8:B19,D8:D19,F8:F19,H8:H19,J8:J19,L8:L19,N 8:N19"))
If vRngInput Is Nothing Then Exit Sub
For Each rng In vRngInput
'Determine the color
Select Case rng.Value
Case Is = "SSH": Num = 38
Case Is = "SMH": Num = 39
Case Is = "SSO": Num = 28
Case Is = "SKMH": Num = 36
Case Is = "SA": Num = 43
Case Is = "SBC": Num = 45
Case Is = "HC": Num = 32
Case Is = "ADMIN": Num = 54
Case Is = "OC": Num = 15
End Select
'Apply the color
rng.Resize(1, 2).Interior.ColorIndex = Num
With Worksheets("Sheet2").Range(Target.Address)
.Value = Target.Value
.Resize(1, 2).Interior.ColorIndex = Num
End With
Next rng
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Erik" wrote in message
...
Frank,
Problem is I have code in both sheets to format the cells color based on
the text value in the cell. Using the formula in sheet2, the code doesn't
seem to recognize the value and therefore doesn't format the cell. I was
thinking there must be a way to modify my existing cell formatting code to
do the job or insert an additional sub. A looped routine that looks at each
cell in a range individually and copies it to sheet2 maybe. Here is the
code I'm using for the formatting:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Num As Long
Dim rng As Range
Dim vRngInput As Variant
Set vRngInput = Intersect(Target,
Range("B8:B19,D8:D19,F8:F19,H8:H19,J8:J19,L8:L19,N 8:N19"))
If vRngInput Is Nothing Then Exit Sub
For Each rng In vRngInput
'Determine the color
Select Case rng.Value
Case Is = "SSH": Num = 38
Case Is = "SMH": Num = 39
Case Is = "SSO": Num = 28
Case Is = "SKMH": Num = 36
Case Is = "SA": Num = 43
Case Is = "SBC": Num = 45
Case Is = "HC": Num = 32
Case Is = "ADMIN": Num = 54
Case Is = "OC": Num = 15
End Select
'Apply the color
rng.Interior.ColorIndex = Num
rng.Offset(0, 1).Interior.ColorIndex = Num
Next rng
End Sub