Change Cell colour on click

[goneil]

I have 4 cells in a row A1, A2, A3, A4
Is there a way to change the colour of a cell just by clicking in it?
(eg) A1=Blue, A2=Green, A3=Orange, A4= Red

The other 3 cells are to be reset to blank.
Excel 2003, SP3
A big thank you to whoever knows the answer.
Cheers George

 

[L. Howard Kittle]

You have two solutions in your other post on 10/20 @ 10:56PM

I tried them, both work as you requested.

If you cannot view your past post for some reason, post back here and I or
someone can post the solutions from there to here for you...

HTH
Regards,
Howard

 

[p45cal]

I have 4 cells in a row A1, A2, A3, A4
Is there a way to change the colour of a cell just by clicking in it?
(eg) A1=Blue, A2=Green, A3=Orange, A4= Red

The other 3 cells are to be reset to blank.
Excel 2003, SP3
A big thank you to whoever knows the answer.
Cheers George

I can't find which other posts Howard is referring to - which
newsgroup?

Anyway, I can do it on a double-click easily enough; this code in the
code module of the sheet concerned:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target
As Range, Cancel As Boolean)
If Intersect(Target, Range("A1:A4")) Is Nothing Then
Exit Sub
Else
Cancel = True
i = 0
For Each cll In Range("A1:A4")
i = i + 1
If cll.Address = Target.Address Then
cll.Interior.ColorIndex = Application.WorksheetFunction.Choose(i,
5, 43, 44, 3)
Else
cll.Interior.ColorIndex = xlNone
End If
Next cll
End If
End Sub

 

[Gary''s Student]

First install the following macro in a standard module and run it:

Sub Macro1()
ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="",
SubAddress:= _
"Sheet1!A1", TextToDisplay:=" "
ActiveSheet.Hyperlinks.Add Anchor:=Range("A2"), Address:="",
SubAddress:= _
"Sheet1!A2", TextToDisplay:=" "
ActiveSheet.Hyperlinks.Add Anchor:=Range("A3"), Address:="",
SubAddress:= _
"Sheet1!A3", TextToDisplay:=" "
ActiveSheet.Hyperlinks.Add Anchor:=Range("A4"), Address:="",
SubAddress:= _
"Sheet1!A4", TextToDisplay:=" "
End Sub

This just sets up some hyperlinks in A1 thru A4

Then install the following worksheet event macro in the worksheet code area:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
i = Right(Target.Parent.Address, 1)
Dim r As Range, r2 As Range
Set r2 = Range(Target.Parent.Address)
Set r = Range("A1:A4")
r.Interior.ColorIndex = xlNone
red = 3
green = 10
yellow = 6
blue = 5
With r2.Interior
If i = 1 Then .ColorIndex = red
If i = 2 Then .ColorIndex = green
If i = 3 Then .ColorIndex = yellow
If i = 4 Then .ColorIndex = blue
End With
End Sub

 

[goneil]

Hi p45cal, thank you so much it is almost there.
I did not make myself very clear sorry.
Whichever cell I click in I want the others to reset. (eg) if I make a
mistake and click in A1 when I really meant A2, I want to be able to just
click in A2 and A1, A3, A4 get reset and so on.

Cheers
George

 

[p45cal]

Hi p45cal, thank you so much it is almost there.
I did not make myself very clear sorry.
Whichever cell I click in I want the others to reset. (eg) if I make a
mistake and click in A1 when I really meant A2, I want to be able t
just
click in A2 and A1, A3, A4 get reset and so on.

Cheers
George

Yes, that's what happens with my snippet, are you saying the other
don't clear (the line *cll.Interior.ColorIndex = xlNone* is responsibl
for clearing the others)? It works here.
The deficiency in my code is that it requires a *double*-click to wor
rather than the *single *click you wanted

 

[goneil]

What happened was I double clicked on A1 and it went blue, then I double
clicked on A2 but nothing happened. A1 just stayed blue and the other cells
where just reacting as if normal cells.

In case I have copied something wrong I have pasted it below. THX.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)

If Intersect(Target, Range("A1:A4")) Is Nothing Then
Exit Sub
Else
Cancel = True
i = 0
For Each cll In Range("A1:A4")
i = i + 1
If cll.Address = Target.Address Then
cll.Interior.ColorIndex =
Application.WorksheetFunction.Choose(i, 5, 43, 44, 3)
Else
cll.Interior.ColorIndex = xlNone
End If
Next cll
End If

End Sub

 

[p45cal]

Testing the code you've just included it worked fine here in xl2003 an
xl2007..after dealing with any lines that had been wrapped to the nex
line by the messaging system

 

[goneil]

Hi p45cal,

You are right it does work. I got mixed up, I meant for it to be across the
sheet and not down (A1, B1, C1, D1) and was testing it across..Sorry. I just
had a few senior moments p45cal.. (I turned 60 last week). You were perfect
p45cal.

Thank you so much, your time and effort and knowledge is very much
appreciated.

George