Fill Color Macro

[cranen]

My code is shown below. I have two questions - When I protect my sheet, it
no longer allows the cells to be color filled based on the value, any way to
allow this to happen? Right now only column A is color coded. I would like
columns B and C to be filled with the same color as A1, A2, A3, etc. based on
the value entered in column A. Any suggestions? Your help is greatly
appreciated. Thanks.

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A3:A322"

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
Select Case .Value
Case 1: .Interior.ColorIndex = 44
Case 2: .Interior.ColorIndex = 46
Case 3: .Interior.ColorIndex = 45
Case 4: .Interior.ColorIndex = 36
Case 5: .Interior.ColorIndex = 29
Case 6: .Interior.ColorIndex = 38
Case 7: .Interior.ColorIndex = 39
Case 8: .Interior.ColorIndex = 40
Case 9: .Interior.ColorIndex = 30
Case 10: .Interior.ColorIndex = 26
Case 11: .Interior.ColorIndex = 22
Case 12: .Interior.ColorIndex = 3
Case 13: .Interior.ColorIndex = 19
Case 14: .Interior.ColorIndex = 4
Case 15: .Interior.ColorIndex = 8
Case 16: .Interior.ColorIndex = 12
Case 17: .Interior.ColorIndex = 15
Case 18: .Interior.ColorIndex = 17
Case 19: .Interior.ColorIndex = 20
Case 20: .Interior.ColorIndex = 28
Case 21: .Interior.ColorIndex = 33
Case 22: .Interior.ColorIndex = 2
Case 23: .Interior.ColorIndex = 35
Case 24: .Interior.ColorIndex = 37
Case 25: .Interior.ColorIndex = 23
Case 26: .Interior.ColorIndex = 42
Case 27: .Interior.ColorIndex = 43
Case 28: .Interior.ColorIndex = 47
Case 29: .Interior.ColorIndex = 2
Case 30: .Interior.ColorIndex = 34
Case "": .Interior.ColorIndex = 2

End Select
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

 

[Per Jessen]

Hi

You have to unprotect the sheet (by macro) before you can change the color,
and use 'Resize' to enlarge the range to color:

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A3:A322"

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
ActiveSheet.Unprotect Password:="JustMe"
With Target
Select Case .Value
Case 1: .Resize(1, 3).Interior.ColorIndex = 44
Case 2: .Resize(1, 3).Interior.ColorIndex = 46
Case 3: .Resize(1, 3).Interior.ColorIndex = 45
Case 4: .Resize(1, 3).Interior.ColorIndex = 36
Case 5: .Resize(1, 3).Interior.ColorIndex = 29
Case 6: .Resize(1, 3).Interior.ColorIndex = 38
Case 7: .Resize(1, 3).Interior.ColorIndex = 39
Case 8: .Resize(1, 3).Interior.ColorIndex = 40
Case 9: .Resize(1, 3).Interior.ColorIndex = 30
Case 10: .Resize(1, 3).Interior.ColorIndex = 26
Case 11: .Resize(1, 3).Interior.ColorIndex = 22
Case 12: .Resize(1, 3).Interior.ColorIndex = 3
Case 13: .Resize(1, 3).Interior.ColorIndex = 19
Case 14: .Resize(1, 3).Interior.ColorIndex = 4
Case 15: .Resize(1, 3).Interior.ColorIndex = 8
Case 16: .Resize(1, 3).Interior.ColorIndex = 12
Case 17: .Resize(1, 3).Interior.ColorIndex = 15
Case 18: .Resize(1, 3).Interior.ColorIndex = 17
Case 19: .Resize(1, 3).Interior.ColorIndex = 20
Case 20: .Resize(1, 3).Interior.ColorIndex = 28
Case 21: .Resize(1, 3).Interior.ColorIndex = 33
Case 22: .Resize(1, 3).Interior.ColorIndex = 2
Case 23: .Resize(1, 3).Interior.ColorIndex = 35
Case 24: .Resize(1, 3).Interior.ColorIndex = 37
Case 25: .Resize(1, 3).Interior.ColorIndex = 23
Case 26: .Resize(1, 3).Interior.ColorIndex = 42
Case 27: .Resize(1, 3).Interior.ColorIndex = 43
Case 28: .Resize(1, 3).Interior.ColorIndex = 47
Case 29: .Resize(1, 3).Interior.ColorIndex = 2
Case 30: .Resize(1, 3).Interior.ColorIndex = 34
Case "": .Resize(1, 3).Interior.ColorIndex = 2
End Select
ActiveSheet.Protect Password:="JustMe"
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

Regards,
Per

 

[Dave Peterson]

Case 1: .Interior.ColorIndex = 44
becomes:
Case 1: .resize(1,2).Interior.ColorIndex = 44

(along with all those other lines, too)

 

[Dave Peterson]

change it .resize(1,3)

Case 1: .Interior.ColorIndex = 44
becomes:
Case 1: .resize(1,2).Interior.ColorIndex = 44

(along with all those other lines, too)

 

[cranen]

I want other users to have the benefit of the color change by entered value,
but I have to protect the sheet so they don't destroy it. Am I out of luck?

 

[cranen]

Sorry. I wrote before I tried it. It works just fine. Thanks for you help.