Assume: if B then also E, if F then I, if J then M etc


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,F8:F19,J8:J19,N8:N19,R8:R19,V8:V19,Z 8:Z19"))
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,3).Interior.ColorIndex = Num
Next rng
End Sub


if it is only B then do E then change
rng.Offset(0,3).Interior.ColorIndex = Num

to
if rng.Column = 2 then _
rng.Offset(0,3).Interior.ColorIndex = Num




--
Regards,
Tom Ogilvy


"Erik" wrote in message
...
With the help of Mr. de Bruin and Mr. Dibben, I have successfully applied
a color code to an aray of cells using the suggested code. The cells in
seven columns have been colored based on their text value. Now I am trying
to apply the same colors to the cells in an adjacent column regardless of
their content. For instance, cell B8 is assigned a color based on its
content and I want to apply the same color to E8 even though E8 may be
empty. Then B9 and E9 etc. Any suggestions would be appreciated. I am
currently using the following code:
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,F8:F19,J8:J19,N8:N19,R8:R19,V8:V19,Z 8:Z19"))
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
Next rng
End Sub