PDA

View Full Version : Solved: Range cell color by Double Clicking



IgnBan
03-19-2008, 10:08 AM
How can I change the cell formatting (color) and cell contends (date) in a columns cell?
I got 5 columns and I need in the first four to change the color and on the 5th to put today?s current date by clicking or double clicking any cell in this columns.
I have sheet1 that I want to click or double click on a cell and change the color of the cell, the cells are originally ?No Fill?, but I want to predefine a color when I click or double click, for example I want Colum A be red, B blue, C yellow and D green when I click on any cell in this range. I need the functionality to toggle this on and off. The 5th column E to print today?s current date in any cell in this column when clicked (or double clicked)?
On the coloring of the cell I?m working on this code;

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
when double-clicked again.



If Target.Interior.ColorIndex = xlNone Then


Target.Interior.ColorIndex = 3

ElseIf Target.Interior.ColorIndex = 3 Then


Target.Interior.ColorIndex = xlNone

End If

Cancel = True

End Sub


Now what is the best way to predefine the ranges for the rest of colors?
Any Help is in advance appreciated :thumb

thomaspatton
03-19-2008, 10:29 AM
try this :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
'To add more columns, start copying below this line...
If .Column = 1 Then
If .Interior.ColorIndex = 1 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 1
End If
ElseIf .Column = 2 Then
If .Interior.ColorIndex = 3 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 3
End If
'...and paste the new line here.
'Change the .Cloumn reference to the next column and pick a color.
End If
End With
End Sub

lucas
03-19-2008, 10:40 AM
Here's my shot at it Jose:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
If Target.Column = 1 Then
If Target.Interior.ColorIndex = xlNone Then
Target.Interior.ColorIndex = 3
ElseIf Target.Interior.ColorIndex = 3 Then
Target.Interior.ColorIndex = xlNone
End If

ElseIf Target.Column = 2 Then
If Target.Interior.ColorIndex = xlNone Then
Target.Interior.ColorIndex = 5
ElseIf Target.Interior.ColorIndex = 5 Then
Target.Interior.ColorIndex = xlNone
End If

ElseIf Target.Column = 3 Then
If Target.Interior.ColorIndex = xlNone Then
Target.Interior.ColorIndex = 6
ElseIf Target.Interior.ColorIndex = 6 Then
Target.Interior.ColorIndex = xlNone
End If

ElseIf Target.Column = 4 Then
If Target.Interior.ColorIndex = xlNone Then
Target.Interior.ColorIndex = 4
ElseIf Target.Interior.ColorIndex = 4 Then
Target.Interior.ColorIndex = xlNone
End If

ElseIf Target.Column = 5 Then
Target.Value = Format(Date, "mmmm.d.yyyy")
End If

Application.EnableEvents = True
End Sub

Bob Phillips
03-19-2008, 10:59 AM
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim i As Long, j As Long
Dim aryColours

aryColours = Array(3, 5, 6, 10, xlColorIndexNone)
If Not Intersect(Target, Me.Range("A:D")) Is Nothing Then

With Target

On Error Resume Next
j = Application.Match(Me.Range("A" & .Row).Interior.ColorIndex, aryColours, 0)
On Error GoTo 0
Select Case j
Case 0: j = 1
Case 5: j = 1
Case Else: j = j + 1
End Select
For i = 1 To 4

Me.Cells(.Row, i).Interior.ColorIndex = aryColours(j - 1)
j = j + 1
If j = 6 Then j = 1
Next i
Me.Cells(.Row, "E") = Format(Date, "dd mmm yyyy")

Cancel = True
End With
End If
End Sub

mikerickson
03-19-2008, 11:01 AM
I think this combination of routines will do what you want.Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column < 6 And Not(ToggleDisable) Then
Application.EnableEvents = False
With Target.EntireRow
If .Range("a1").Interior.ColorIndex = 3 Then
.Range("a1:D1").Interior.ColorIndex = xlNone
Else
.Range("A1").Interior.ColorIndex = 3
.Range("B1").Interior.ColorIndex = 2
.Range("c1").Interior.ColorIndex = 6
.Range("d1").Interior.ColorIndex = 4
End If
.Range("e1").Value = Format(Date, "mmmm.d.yyyy")
End With
Application.EnableEvents = True
End If
End Sub
in a normal Module
Public ToggleDisable As Boolean

Sub ToggleDoubleClickActionRoutine()
ToggleDisable = Not (ToggleDisable)
End Sub

mikerickson
03-19-2008, 12:12 PM
Rereading the OP, I'm not clear what color behaviour is desired. (color all cells?, if column 2 is colored does clicking column 3 un-color column2...), perhaps this is closer to what the OP wants than the "color all cells" I suggested earlier.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim newColor As Long
If Target.Column < 6 And Not (toggleDisable) Then
Application.EnableEvents = False
With Target
newColor = Application.Choose(.Column, 3, 5, 6, 4, xlNone)
.EntireRow.Range("a1:d1").Interior.ColorIndex = xlNone
.Interior.ColorIndex = newColor
.EntireRow.Range("e1").Value = Format(Date, "mmmm.d.yyyy")
End With
Application.EnableEvents = True
End If
End Sub

lucas
03-19-2008, 12:25 PM
I'm not clear either Mike. I took it to mean he wanted to color specific cells...not rows.....

It has been interpreted both was here so maybe Jose could clear this up for us.

IgnBan
03-19-2008, 12:38 PM
WOW!.....sorry guys I toughed I was logged in, but after closing the browser I opened it and see all the code alternatives, let me go through the code samples and I'll be back to give you feedback.

Mike/Lucas, yes I need to color 4 colums (A,B,C, and D) and on the 5th colunm double click and print the current date.

lucas
03-19-2008, 12:53 PM
You have to hit refresh once in a while Jose....to see posts added after yours.

mikerickson
03-19-2008, 03:12 PM
Mike/Lucas, yes I need to color 4 colums (A,B,C, and D) and on the 5th colunm double click and print the current date.
Is the code in post #5 doing what you want?

IgnBan
03-20-2008, 07:02 AM
OK guys, I want to thank every one of you for the code suggestion.

Thanks again guys, I just can believe how lucky I am when I saw the 4 of you answering my post. I know Mikerickson from other Forums, I know how talented he is, Thomaspatton have seen his code and personal applications, grate code, XLD and Lucas VBA Gurus , 4 VBA Gurus answering my post.

Now, what code fits the need;
First and second code from c Mikerickson.; It color all the cell at ones and I need to color one cell at a time , XLD same thing color all cells. Thomas color cells the intended way but doesn’t do the date in cell. Lucas code does the date cell correctly but doesn’t toggle the cell coloring. I summary I need color cells in rows like Thomaspatton code toggling on and off and date in cell like Lucas. I can use Lucas code and set Cancel = True to make it toggled, but date cells don’t toggle.

Bob Phillips
03-20-2008, 07:16 AM
Is this what you mean?



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim i As Long, j As Long
Dim aryColours

aryColours = Array(3, 5, 6, 10, xlColorIndexNone)
If Not Intersect(Target, Me.Range("A:D")) Is Nothing Then

With Target

On Error Resume Next
j = Application.Match(Target.Interior.ColorIndex, aryColours, 0)
On Error GoTo 0
Select Case j
Case 0: j = 1
Case 5: j = 1
Case Else: j = j + 1
End Select
Target.Interior.ColorIndex = aryColours(j - 1)
Cancel = True
End With
ElseIf Not Intersect(Target, Me.Range("E:E")) Is Nothing Then

Target.Value = Format(Date, "dd mmm yyyy")
End If
End Sub

thomaspatton
03-20-2008, 07:18 AM
Easy fix, sorry I missed the date entry.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
'To add more columns, start copying below this line...
If .Column = 1 Then
If .Interior.ColorIndex = 1 Then
.Interior.ColorIndex = xlNone
.Offset(0, 4).Value = Format(Date, "mmmm.d.yyyy")
Else
.Interior.ColorIndex = 1
.Offset(0, 4).Value = Format(Date, "mmmm.d.yyyy")
End If
ElseIf .Column = 2 Then
If .Interior.ColorIndex = 3 Then
.Interior.ColorIndex = xlNone
.Offset(0, 3).Value = Format(Date, "mmmm.d.yyyy")
Else
.Interior.ColorIndex = 3
.Offset(0, 3).Value = Format(Date, "mmmm.d.yyyy")
End If
'...and paste the new line here.
'Change the .Column reference to the next column and pick a color.
'Also, now change the .Offset(0, -> 3 <- ) to offset it to the
'appropriate column. Basically, it comes down to counting columns
End If
End With
End Sub

IgnBan
03-20-2008, 09:17 AM
XLD the columns will be one determinate color, I see what you code does, it let you choose the color be double clicking, but in this case I predefined the colors as; if double clicked column "A" the cell will have to turn RED, "B" BLUE, "C" YELLOW and "D" GREEN, also when I double click "E" the date prints but can toggled on and off.
Thomaspatton I adapted the code to offset the appropriate columns but I want the date cell to be independent of the color cells, in another words even if a colored rage cells are not clicked, I want to be able to double click and toggle the date cell date on and off.

thomaspatton
03-20-2008, 09:37 AM
Ahh! I see said the Blind man...


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
'To add more columns, start copying below this line...
If .Column = 1 Then
If .Interior.ColorIndex = 1 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 1
End If
ElseIf .Column = 2 Then
If .Interior.ColorIndex = 3 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 3
End If
'...and paste the new line here.
'Change the .Column reference to the next column and pick a color.

'This will be your entry for Column 5
ElseIf .Column = 5 Then
If .Value = "" Then
.Value = Format(Date, "mmmm.d.yyyy")
Else
.Value = ""
End If
End If
End With
End Sub





All I did was change Column 5. Instead of coloring the Cell, it Adds the date if blank and blanks the cell if it has info in it.

IgnBan
03-20-2008, 10:02 AM
Thomaspatton the code works fine, I got a question; Why is it that in the first code you posted I can toggled the colors on on and off without moving the focus from the cell? and the last code you have to move the focus away from the cell and then put move the mouse back on the cell to toggle the color on and off? Same thing with the date cell.

lucas
03-20-2008, 10:32 AM
Jose,

You can use a
Range("A1").Select

after each if statement as a workaround for this problem.....I have used it that way before for checkboxes in cells. You can use any cell on the worksheet if A1 is not convenient.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
'To add more columns, start copying below this line...
If .Column = 1 Then
If .Interior.ColorIndex = 1 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 1
End If
Range("A1").Select
ElseIf .Column = 2 Then
If .Interior.ColorIndex = 3 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 3
End If
Range("A1").Select
'...and paste the new line here.
'Change the .Column reference to the next column and pick a color.

'This will be your entry for Column 5
ElseIf .Column = 5 Then
If .Value = "" Then
.Value = Format(Date, "mmmm.d.yyyy")
Else
.Value = ""
End If
Range("A1").Select
End If
End With
End Sub

mdmackillop
03-20-2008, 10:44 AM
Steve,
Replace Range("A1").Select with Cancel = True

lucas
03-20-2008, 10:51 AM
I remember that now Malcolm.....thanks for reminding me. I was using selection change for my checkboxes and cancel = true does not seem to work for that........

Bob Phillips
03-20-2008, 11:04 AM
Because it is not an event argument to that event, only Target.

lucas
03-20-2008, 11:33 AM
It's all in the details.........I need a refresher every day....

IgnBan
03-20-2008, 03:22 PM
Thanks to Lucas, XLD, mdmackillop, thomaspatton, mikerickson, you guys are very talented. this is the final code adapted to may project, it toggles the color cells on and off including the date cells.

Thanks Team! :thumb

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

With Target

If .Column = 4 Then
If .Interior.ColorIndex = 4 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 4
End If
ElseIf .Column = 5 Then
If .Interior.ColorIndex = 3 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 3
End If
ElseIf .Column = 6 Then
If .Interior.ColorIndex = 6 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 6
End If
ElseIf .Column = 7 Then
If .Interior.ColorIndex = 5 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 5
End If
ElseIf .Column = 8 Then
If .Interior.ColorIndex = 7 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 7
End If

ElseIf .Column = 3 Then
If .Value = "" Then
.Value = Format(Date, "mmmm.d.yyyy")
Else
.Value = ""
End If

End If
End With
Cancel = True

End Sub

Edit Lucas: Jose, I deleted the duplicate post....

mdmackillop
03-20-2008, 04:45 PM
Pass the values to a sub routine. It's more flexible and easirer to maintain

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Select Case Target.Column
Case 4
DoColour Target, 4
Case 5
DoColour Target, 3
Case 6
DoColour Target, 6
Case 7
DoColour Target, 5
Case 8
DoColour Target, 7
Case 3
If Target.Value = "" Then
Target.Value = Format(Date, "mmmm.d.yyyy")
Else
Target.Value = ""
End If
End Select
Cancel = True
End Sub

Sub DoColour(Target As Range, Col As Long)
With Target
If .Interior.ColorIndex = Col Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = Col
End If
End With
End Sub