Solved: Click to color

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):

Code:

---

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

---

Right click the sheet's tab, View Code, and paste:

Code:

---

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:

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

---

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:

Code:

---

    i = Target.Row

---

to:

Code:

---

    i = Target.Row
    if i < 2 Then Exit Sub

---

if your data starts on the second row

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:

Code:

---

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:

http://www.vbaexpress.com/forum/data...BJRU5ErkJggg==

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

Replace

Code:

---

If i < 11 Then Exit Sub

---

with

Code:

---

If Asc(Left(Range("A" & i) & "0", 1)) < 65 Then Exit Sub

---

This is based on the asumption that your title column is A and always the titles start with a number.

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)

Quote:

---

Originally Posted by JEPEDEWE

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" part :)

Great... works perfectly
Thanks a lot
JP, Belgium