CELL COLOR

[dennisdjones]

Have existing Row colors from a code am using from "Mudface"

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub
If UCase(Target) = "e" Then Target.EntireRow.Interior.ColorIndex = 3
If UCase(Target) = "E" Then Target.EntireRow.Interior.ColorIndex = 3
If UCase(Target) = "u" Then Target.EntireRow.Interior.ColorIndex = 8
If UCase(Target) = "U" Then Target.EntireRow.Interior.ColorIndex = 8
If UCase(Target) = "p" Then Target.EntireRow.Interior.ColorIndex = 4
If UCase(Target) = "P" Then Target.EntireRow.Interior.ColorIndex = 4
If UCase(Target) = "w" Then Target.EntireRow.Interior.ColorIndex = 6
If UCase(Target) = "W" Then Target.EntireRow.Interior.ColorIndex = 6
If UCase(Target) = "O" Then Target.EntireRow.Interior.ColorIndex = 46
If UCase(Target) = "o" Then Target.EntireRow.Interior.ColorIndex = 46
If UCase(Target) = "a" Then Target.EntireRow.Interior.ColorIndex = 2
If UCase(Target) = "A" Then Target.EntireRow.Interior.ColorIndex = 2

End Sub

Have tried some of the traveling color codes, but they clear the existing color formats as they cross that row.

Anymore ideas would be a great plus.

Thanks

dennisdjones
This message was edited by dennisdjones on 2002-08-12 10:47

 

[Fane Duru]

Hi,
I'm new in this forum and I have just found in the last week the problem regarding "Color Banding to Current Cell".
Here is my code which does not disturb any Conditional Formating. It works for multiple cells selection, too.
I don't know if somebody looks to the old thinks but I hope they do.

'For the sheet you wont to play
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Culoare(Target)
End Sub

'The Sub Culoare has to be in a module having the next code:
Option Base 1
Public test As New Collection 'IT STAYS IN MEMORY AFTER THE CODE IS STOPPED !!
Sub Culoare(z)
Dim Arr1(), Arr2(), x As Range, y As Range

Call ReMake 'It restores the initial background

'The background of the cells on the active one rowt is memorised
ReDim Arr1(z.Column + 1, z.Column)
For i = 1 To z.Column
Arr1(1, i) = Cells(z.Row, i).Interior.ColorIndex
Next i
Arr1(2, 1) = z.Row

'The background of the cells on the active one column is memorised
ReDim Arr2(z.Row + 1, z.Row)
For j = 1 To z.Row
Arr2(1, j) = Cells(j, z.Column).Interior.ColorIndex
Next j
Arr2(2, 1) = z.Column

'The memorised data are inputed in "test"
test.Add Arr1
test.Add Arr2

'This is, in fact, the main side of the code. We'll color the bakkground.
Set x = Range(Cells(z.Row, 1), Cells(z.Row, z.Column))
Set y = Range(Cells(1, z.Column), Cells(z.Row, z.Column))
If z.Interior.ColorIndex <> 6 Then
x.Interior.ColorIndex = 36
y.Interior.ColorIndex = 36
Else
x.Interior.ColorIndex = 37
y.Interior.ColorIndex = 37
End If

'We'll take out from "test" the old memorised data
If test.Count > 2 Then
For i = 1 To test.Count - 2
test.Remove 1
Next i
End If
End Sub
Sub ReMake()
'the initial background is restored
If test.Count >= 2 Then
For t = 1 To UBound(test(1)) - 1
Cells(test(1)(2, 1), t).Interior.ColorIndex = test(1)(1, t)
Next t
For g = 1 To UBound(test(2)) - 1
Cells(g, test(2)(2, 1)).Interior.ColorIndex = test(2)(1, g)
Next g
End If
End Sub

'An elegant way to stop the workbook is:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call ReMake
Set test = Nothing
If ThisWorkbook.Saved Then ThisWorkbook.Save
End Sub

 

[Ivan F Moala]

On 2002-09-04 03:30, Fane Duru wrote:
Hi,
I'm new in this forum and I have just found in the last week the problem regarding "Color Banding to Current Cell".
Here is my code which does not disturb any Conditional Formating. It works for multiple cells selection, too.
I don't know if somebody looks to the old thinks but I hope they do.

'For the sheet you wont to play
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Culoare(Target)
End Sub

'The Sub Culoare has to be in a module having the next code:
Option Base 1
Public test As New Collection 'IT STAYS IN MEMORY AFTER THE CODE IS STOPPED !!
Sub Culoare(z)
Dim Arr1(), Arr2(), x As Range, y As Range

Call ReMake 'It restores the initial background

'The background of the cells on the active one rowt is memorised
ReDim Arr1(z.Column + 1, z.Column)
For i = 1 To z.Column
Arr1(1, i) = Cells(z.Row, i).Interior.ColorIndex
Next i
Arr1(2, 1) = z.Row

'The background of the cells on the active one column is memorised
ReDim Arr2(z.Row + 1, z.Row)
For j = 1 To z.Row
Arr2(1, j) = Cells(j, z.Column).Interior.ColorIndex
Next j
Arr2(2, 1) = z.Column

'The memorised data are inputed in "test"
test.Add Arr1
test.Add Arr2

'This is, in fact, the main side of the code. We'll color the bakkground.
Set x = Range(Cells(z.Row, 1), Cells(z.Row, z.Column))
Set y = Range(Cells(1, z.Column), Cells(z.Row, z.Column))
If z.Interior.ColorIndex <> 6 Then
x.Interior.ColorIndex = 36
y.Interior.ColorIndex = 36
Else
x.Interior.ColorIndex = 37
y.Interior.ColorIndex = 37
End If

'We'll take out from "test" the old memorised data
If test.Count > 2 Then
For i = 1 To test.Count - 2
test.Remove 1
Next i
End If
End Sub
Sub ReMake()
'the initial background is restored
If test.Count >= 2 Then
For t = 1 To UBound(test(1)) - 1
Cells(test(1)(2, 1), t).Interior.ColorIndex = test(1)(1, t)
Next t
For g = 1 To UBound(test(2)) - 1
Cells(g, test(2)(2, 1)).Interior.ColorIndex = test(2)(1, g)
Next g
End If
End Sub

'An elegant way to stop the workbook is:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call ReMake
Set test = Nothing
If ThisWorkbook.Saved Then ThisWorkbook.Save
End Sub

Hello Fane Duru
Welcome to the Board.
Thats a GREAT work around to get over the
Conditional formating issue. Nice work with using a Collection.
I have saved this code for use in limited areas as the code will slow down when accessing larger areas as would be expected when the Arrays get larger
eg scrolling over to ever increasing areas
slows the application right down....Good work though!

 

[verluc]

On 2002-05-21 14:21, NateO wrote:
Jack, your link is broken, am curious though. In the interim, I'll stick with a worksheet event, although as Russell mentions, and for multiple sheets, you'll want the Workbook_SheetSelectionChange procedure, which goes in the 'ThisWorkbook' module.<pre>
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim cl As Range
Static n As Range
On Error GoTo 1
For Each cl In Range("a" & n.Row, n)
If cl.Interior.ColorIndex = 36 Then _
cl.Interior.ColorIndex = xlNone
Next cl
For Each cl In Range("a" & Target.Row, Target)
If cl.Interior.ColorIndex = xlNone Then _
cl.Interior.ColorIndex = 36
Next cl
1: Set n = Target
End Sub</pre>

This is a worksheet event, it needs to go in a worksheet module. Right-click on the sheet, view code and paste the code.

It won't overwrite any color except index 36: "Mellow Yellow"

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue">O</font></font></font>
This message was edited by NateO on 2002-05-21 15:39

Ho NateO,
With your macro above,is it also possible that in the same time the vertical column also can be uplighted.
So when when the row is 8 and the column is F then the row A8 and the column F8 is highlighted.
Thanks for answer.

 

[verluc]

On 2002-05-21 14:21, NateO wrote:
Jack, your link is broken, am curious though. In the interim, I'll stick with a worksheet event, although as Russell mentions, and for multiple sheets, you'll want the Workbook_SheetSelectionChange procedure, which goes in the 'ThisWorkbook' module.<pre>
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim cl As Range
Static n As Range
On Error GoTo 1
For Each cl In Range("a" & n.Row, n)
If cl.Interior.ColorIndex = 36 Then _
cl.Interior.ColorIndex = xlNone
Next cl
For Each cl In Range("a" & Target.Row, Target)
If cl.Interior.ColorIndex = xlNone Then _
cl.Interior.ColorIndex = 36
Next cl
1: Set n = Target
End Sub</pre>

This is a worksheet event, it needs to go in a worksheet module. Right-click on the sheet, view code and paste the code.

It won't overwrite any color except index 36: "Mellow Yellow"

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue">O</font></font></font>
This message was edited by NateO on 2002-05-21 15:39

Ho NateO,
With your macro above,is it also possible that in the same time the vertical column also can be uplighted.
So when when the row is 8 and the column is F then the row A8 and the column F8 is highlighted.
Thanks for answer.

 

[verluc]

On 2002-05-21 14:21, NateO wrote:
Jack, your link is broken, am curious though. In the interim, I'll stick with a worksheet event, although as Russell mentions, and for multiple sheets, you'll want the Workbook_SheetSelectionChange procedure, which goes in the 'ThisWorkbook' module.<pre>
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim cl As Range
Static n As Range
On Error GoTo 1
For Each cl In Range("a" & n.Row, n)
If cl.Interior.ColorIndex = 36 Then _
cl.Interior.ColorIndex = xlNone
Next cl
For Each cl In Range("a" & Target.Row, Target)
If cl.Interior.ColorIndex = xlNone Then _
cl.Interior.ColorIndex = 36
Next cl
1: Set n = Target
End Sub</pre>

This is a worksheet event, it needs to go in a worksheet module. Right-click on the sheet, view code and paste the code.

It won't overwrite any color except index 36: "Mellow Yellow"

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue">O</font></font></font>
This message was edited by NateO on 2002-05-21 15:39

Hi NateO,
With your macro above,is it also possible that in the same time the vertical column also can be uplighted.
So when when the row is 8 and the column is F then the row A8 and the column F8 is highlighted.
Thanks for answer.

 

[Jammer]

For Yogi - regarding the conditional formatting formula above, can you explain the formula (what it means, how it works): =and(cell("contents")"",row()=cell(row). I don't understand the row()=cell(row) part. Can you explain to me that part. Thanks.

 

[RichardS]

Verluc,

Have a look at Ivan's accomplishment in the Hall of Fame forum on this Board

Richard

 

[Yogi Anand]

On 2002-11-03 19:20, Jammer wrote:
For Yogi - regarding the conditional formatting formula above, can you explain the formula (what it means, how it works): =and(cell("contents")"",row()=cell(row). I don't understand the row()=cell(row) part. Can you explain to me that part. Thanks.

Hi Jammer:
I am going to reproduce the Conditional Formating formula as I had proposed -- it did not come out right in your quote because the use of < character is minterpreted by HTML as part of a tag ...

Formula Is =and(cell("contents")<>"",row()=cell("row")

I applied the formula to the entire sheet by selecting the box on the top left hand corner of the sheet.
I wanted the highliting to apply to a row that was not empty -- so the first part regarding contents, the second part says, if the row number selected matches the row number of the cell.

The formula works -- but there is a caveat -- the cell("contents") part needs to be calculated in some way, such as making an entry in column A of the row, or by using CALCULATE in the Worksheet_SelectionChange event.

Regards!
Yogi Anand

 

[Ivan F Moala]

Highlight cell location alternative:

If you require a highlighter that DOES NOT use conditional formating ie. it preserves all your colours and conditional formating AND also allows you to Copy, Paste and Undo/Redo then try this amended code.

Code was amended from code @ MrExcel by Nate Oliver for Aldo.
Aldo also suggested a work around for deleting of the activecell.
Thanks guys!!

See code for comments.



http://www.xcelfiles.com/Excel02.html#AnchorLink-1

 

[Lizzybob]

Forgive me for being a few years late to this thread, and this may have been covered, but you can copy and paste from the original formula.
Just go to Edit - Office Clipboard. For some reason, when the clipboard is showing, it stores the data, and you can click it to paste. After this is done, you can paste this value again and again to other cells until you copy something else.