![]() |
Fill Color Macro
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 |
Fill Color Macro
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 "cranen" skrev i meddelelsen ... 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 |
Fill Color Macro
Case 1: .Interior.ColorIndex = 44
becomes: Case 1: .resize(1,2).Interior.ColorIndex = 44 (along with all those other lines, too) cranen wrote: 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 -- Dave Peterson |
Fill Color Macro
change it .resize(1,3)
Dave Peterson wrote: Case 1: .Interior.ColorIndex = 44 becomes: Case 1: .resize(1,2).Interior.ColorIndex = 44 (along with all those other lines, too) cranen wrote: 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 -- Dave Peterson -- Dave Peterson |
Fill Color Macro
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? "Per Jessen" wrote: 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 "cranen" skrev i meddelelsen ... 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 |
Fill Color Macro
Sorry. I wrote before I tried it. It works just fine. Thanks for you help.
"Per Jessen" wrote: 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 "cranen" skrev i meddelelsen ... 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 |
All times are GMT +1. The time now is 11:30 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com