Applying background color to cells
 

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 Lon
Dim rng As Rang
Dim vRngInput As Varian
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 Su
For Each rng In vRngInpu
'Determine the colo
Select Case rng.Valu
Case Is = "SSH": Num = 3
Case Is = "SMH": Num = 3
Case Is = "SSO": Num = 2
Case Is = "SKMH": Num = 3
Case Is = "SA": Num = 4
Case Is = "SBC": Num = 4
Case Is = "HC": Num = 3
Case Is = "ADMIN": Num = 5
Case Is = "OC": Num = 1
End Selec
'Apply the colo
rng.Interior.ColorIndex = Nu
Next rn
End Sub

Applying background color to cells
 

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

Applying background color to cells
 

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