Hello Erik,

Target only contains 1 cell so you do not need rng in your code
The routine only reacts to upercase entries
You may consider using either

'Determine the color
Select Case UCASE(Target.Value)
Case Is = "SSH": Num = 38
Select Case UCase(Target.Value)
or
'Determine the color
Target.Value = UCase(Target.Value)
Select Case Target.Value
Case Is = "SSH": Num = 38



Private Sub Worksheet_Change(ByVal Target As Range)
Dim Num As Long
Dim vRngInput As Range
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
'Determine the color
Select Case Target.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
Case Else: Num = 3 ' Color RED on incorrect entry
End Select
'Apply the color
Target.Interior.ColorIndex = Num
'Apply the color to the cell 3 columns to the right
Target.Offset(0, 3).Interior.ColorIndex = Num
End Sub


"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