Hi,
I have 3 cells next to each other
finally, I should end up with an green, orange or red coloured cell
So if I click in cel A1 it turns red, B1 Orange, C1 Green
Other colours (in "non-clicked cells) should disapear
Is this possible?
Thanks
Hi,
I have 3 cells next to each other
finally, I should end up with an green, orange or red coloured cell
So if I click in cel A1 it turns red, B1 Orange, C1 Green
Other colours (in "non-clicked cells) should disapear
Is this possible?
Thanks
Try this, included in the sheet's code (not in workbook's code, not in a module):
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Select Case Target.Address Case "$A$1" Target.Interior.Color = RGB(255, 0, 0) Range("B1").Interior.Color = RGB(255, 255, 255) Range("C1").Interior.Color = RGB(255, 255, 255) Case "$B$1" Target.Interior.Color = RGB(255, 127, 0) Range("A1").Interior.Color = RGB(255, 255, 255) Range("C1").Interior.Color = RGB(255, 255, 255) Case "$C$1" Target.Interior.Color = RGB(0, 255, 0) Range("A1").Interior.Color = RGB(255, 255, 255) Range("B1").Interior.Color = RGB(255, 255, 255) End Select End Sub
Last edited by Aussiebear; 03-20-2023 at 04:07 AM. Reason: Adjusted code tags
Right click the sheet's tab, View Code, and paste:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim iRange As Range If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub ActiveSheet.UsedRange.Interior.Color = xlNone 'Default With ActiveCell .Interior.Color = vbRed .Offset(0, 1).Interior.Color = 4626167 'Orange .Offset(0, 2).Interior.Color = vbGreen End With End Sub
@ Sorin Sion
Your code works great... but...
second part of the question
I have about 450 rows of 3 cells, how to change the code?
Many thanks
JP
Replace with this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim i As Integer i = Target.Row 'Application.EnableEvents = False 'Range("A:C").Select 'Selection.Interior.ColorIndex = xlNone 'Target.Select 'Application.EnableEvents = True '*** Uncomment the lines above if you need a single highlighted cell on the sheet '*** Otherwise you will have a colored cell on each row from the A-C columns where you did a selection Select Case Left(Target.Address, 3) Case "$A$" Target.Interior.Color = RGB(255, 0, 0) Range("B" & i).Interior.ColorIndex = xlNone Range("C" & i).Interior.ColorIndex = xlNone Case "$B$" Target.Interior.Color = RGB(255, 127, 0) Range("A" & i).Interior.ColorIndex = xlNone Range("C" & i).Interior.ColorIndex = xlNone Case "$C$" Target.Interior.Color = RGB(0, 255, 0) Range("A" & i).Interior.ColorIndex = xlNone Range("B" & i).Interior.ColorIndex = xlNone End Select End Sub
Last edited by Aussiebear; 03-20-2023 at 04:09 AM. Reason: Adjusted code tags
It works.... great... thank you soo much
Is it possible to prevent a few cells from colloring... (protect them in a way)
(cells next to a title)
Thanks
Change:
to:i = Target.Row
if your data starts on the second rowi = Target.Row if i < 2 Then Exit Sub
I send you a screendump...
The 3 rectangles on the right is where the colour comes
the grey titles have no colour-rectangles
the tekst next to the colour-rectangles not always is the same
Hope it helps to clear things out!
Thanks
By counting the columns I see in your screenshot I suppose the columns to be colored are K, L and M. Also, the first "data" row would be 11.
If you don't want to adjust the width of the first column, to match the length of the longest text or imposing a fixed width and formatting this first column for wrapping the text (in this case the targeted columns would be B, C, D), the code has to be adjusted like this:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim i As Integer i = Target.Row If i < 11 Then Exit Sub 'Application.EnableEvents = False 'Range("K:M").Select 'Selection.Interior.ColorIndex = xlNone 'Target.Select 'Application.EnableEvents = True '*** Uncomment the lines above if you need a single highlighted cell on the sheet '*** Otherwise you will have a colored cell on each row from the K-M columns where you did a selection Select Case Left(Target.Address, 3) Case "$K$" Target.Interior.Color = RGB(255, 0, 0) Range("L" & i).Interior.ColorIndex = xlNone Range("M" & i).Interior.ColorIndex = xlNone Case "$L$" Target.Interior.Color = RGB(255, 127, 0) Range("K" & i).Interior.ColorIndex = xlNone Range("M" & i).Interior.ColorIndex = xlNone Case "$M$" Target.Interior.Color = RGB(0, 255, 0) Range("K" & i).Interior.ColorIndex = xlNone Range("L" & i).Interior.ColorIndex = xlNone End Select End Sub
Thanks a lot for your kind help,
I have been able to make the adjustments for the correct cells... but thanks anyway
Alas, I think the situation is a bit more complicated
This is a larger part of my screen:
The gray text are titles, so no colouring next to the titles
In you code it all starts at row 11, but there are more rows then just the one on top...
I thought, maybe I could add a column on the left side, enter something like T where teh row has a title
Then (dono if this is the correct way) let the code see if the row has a character "T" in the first cell and the ommits the rest of the code....
Hope it is possible...
Thanks for your kind help
JP
Last edited by JEPEDEWE; 10-26-2011 at 05:32 AM.
ReplacewithIf i < 11 Then Exit SubThis is based on the asumption that your title column is A and always the titles start with a number.If Asc(Left(Range("A" & i) & "0", 1)) < 65 Then Exit Sub
Last edited by Aussiebear; 03-20-2023 at 04:11 AM. Reason: Adjusted code tags
This looks super..
I'll test the code later this evening!
Thanks a lot
Problem solved (I think)
(up to the next one (I will start a new subject for this one)
Hope to be able to help YOU sometimes in the future
small remark,
your code will check for a number, but not for an empty cell... (I think)
Actually it will, because each empty cell will be treated as an "0" by the Range("A" & i) & "0" partOriginally Posted by JEPEDEWE
Great... works perfectly
Thanks a lot
JP, Belgium