Changing cell color with SelectionChange
Posted by Rich on January 18, 2002 4:50 AM
This seems to be a simple problem, but I'm constantly getting an error message.
I have a table across the range A1:J10. The first row (B1:J1) is the header row, and the first column (A2:A10) is the header column (A1 is the dead space). Both headers are gray (color 48). What I would like to do is highlight the individual cells in the header row and column that correspond to a cell selection within the table (range B2:J10). In other words, if F5 is selected, cells F1 and A5 would become red.
The code is copied below, but I keep getting the following error message:
Run-time error '1004': Unable to set the ColorIndex property of the Interior class.
Does anybody have any thoughts on this???
----------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim R, C
R = Target.Row
C = Target.Column
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Range("A1:A10").Select
With Selection.Interior
.ColorIndex = 48 ' <--- PROBLEM
.Pattern = xlSolid
End With
Range("A1:J10").Select
With Selection.Interior
.ColorIndex = 48
.Pattern = xlSolid
End With
ActiveSheet.Cells(R, 1).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ActiveSheet.Cells(1, C).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ActiveSheet.Protect DrawingObjects:=True,
_Contents:=True, Scenarios:=True
End Sub
Posted by Quince on January 18, 2002 5:30 AM
If you select a range in a SelectionChange procedure it will trigger the procedure again !
You either have to change your code to avoid selecting anything (which is very good practice and a good habit to get into for all macros) or put at the start of your code Application.EnableEvents=False and at the end of your code Application.EnableEvents=True
Posted by Joe Was on January 18, 2002 6:46 AM
Try this code
Private Sub Workbook_SheetSelectionChange(ByVal X As Object, _
ByVal Target As Excel.Range)
'Color lable Code, by Jow Was
Dim R As Integer
Dim C As Integer
ActiveSheet.Activate
'Erase last selection colored range.
Range("A:A").Interior.ColorIndex = xlNone
Rows("1:1").Interior.ColorIndex = xlNone
'Get Row & Column address.
R = Selection.Row
C = Selection.Column
ActiveCell.Select
'MsgBox "ROW: " & R & ", Column: " & C
'Color Row lable of selection.
With Cells(R, 1).Interior
.ColorIndex = 48
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
'Color Column lable of selection.
With Cells(1, C).Interior
.ColorIndex = 48
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End Sub
Put this code in the "ThisWorkBook" module. Also, your color selection is a little dark, I would go with a brighter or less gray color? JSW
Posted by Quince on January 18, 2002 7:02 AM
Hmm ... doesn't do what the original code is trying to do.
Posted by Joe Was on January 18, 2002 7:03 AM
This code is Range friendly, the above code is not.
This code will color the lable row and column of a cell selection as does the other macro, only this code will also allow a range to be selected. If a range is selected only the first row and column lable is highlighted. JSW
Private Sub Workbook_SheetSelectionChange(ByVal X As Object, _
ByVal Target As Excel.Range)
'Color lable Code, by Joe Was
Dim R As Integer
Dim C As Integer
ActiveSheet.Activate
'Erase last selection colored range.
Range("A:A").Interior.ColorIndex = xlNone
Rows("1:1").Interior.ColorIndex = xlNone
'Get Row & Column address.
R = Selection.Row
C = Selection.Column
'Color Row lable of selection.
With Cells(R, 1).Interior
.ColorIndex = 8
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
'Color Column lable of selection.
With Cells(1, C).Interior
.ColorIndex = 8
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal X As Object, _
Posted by Rich on January 18, 2002 7:55 AM
Re: This code is Range friendly, the above code is not.
Place this in your forms code module.
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
End If
End Sub
