ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Fill Color Macro (https://www.excelbanter.com/excel-programming/432925-fill-color-macro.html)

cranen

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

Per Jessen

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



Dave Peterson

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

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

cranen

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




cranen

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