CELL COLOR

dennisdjones

New Member
Joined
Apr 13, 2002
Messages
19
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
 
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

Heres another method that takes into account
Nates code and jack concerns. The code is a
little faster.
Drawbacks: Users Conditional formats so Don't use it if you have any in.

Code is a combination of Nates & code I got off of this board by Dave H & Brian ??....
I've adj for other situations.<pre/>

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Integer
'// Amended routine found on this Web site
'// Note: Don't use IF you have Conditional
'// formating that you want to keep!

'// On error resume in case
'// user selects a range of cells
On Error Resume Next
iColor = Target.Interior.ColorIndex
'Leave On Error ON for Row offset errors

If iColor< 0 Then
iColor = 36
Else
iColor = iColor + 1
End If

'// Need this test incase Font color is the same
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1

Cells.FormatConditions.Delete

'// Horizontal color banding
With Range("A" & Target.Row, Target.Address) 'Rows(Target.Row)
.FormatConditions.Add Type:=2, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = iColor
End With

'// Vertical color banding
With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & Target.Offset(-1, 0).Address) 'Rows(Target.Row)
.FormatConditions.Add Type:=2, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = iColor
End With

End Sub</pre>
 
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
And anyone who asks why iopen say Joe PLEASE post more , and Ivan, well what do you say.

I fell ive been taught a lot here, from my simple design to a FULLER way to go about that nagging task,

Guess now its what shoe fit that need.

Joe/Ivan my friends thanks a lot guys///
 
Upvote 0
I am hoping that NateO will see this...

Your suggested code is just what I was
looking for (see above)...so I did a cut and
paste, but nothing seams to happen.

Here is what I did. I went into the Visual
Basic Editor, I found the ThisWorkbook and
Sheet1 under Microsoft Excel Objects. I did
a paste of the code into the window (I tried
both). When I save and go back, there is no
change in the sheet.

I am not familiar with VB, but I have
dabbled a lot with C, so I think that I am
doing what I need to do. It sounds like you
just drop the code in and BOOM, it's working.
Do I need to activate the code some how?

TIA
This message was edited by vshague on 2002-06-19 10:38
 
Upvote 0
OK, it seams that the code just started working...not sure why...

But now I have a new problem. I have several macros that will do some conditional formatting on one column when a button is pressed. I think that when a cell of that column (column G) is highlighted yellow by the procedure, it is causing an error and the spreadsheet locks.

How would the code be modified so that the only cells highlighted would be the cell the cursor is in, Column B, and Column C...and then if the cursor is placed in Column G, nothing is done?

Here is the code for reference...it is also listed on page 1 of this subject:

Thanks
Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, 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
This message was edited by vshague on 2002-06-19 14:28
 
Upvote 0
Howdy V, the code you're using isn't conditional formatting, it's the standard variety, there is quite a difference.

With the modifications you've made, you'll want the code to go in the 'ThisWorkbook' module, it is a workbook procedure. If you have this procedure in a worksheet module, you'll want to delete it. You can tell with event procedures by the name, if it starts with 'Workbook' it goes in the 'ThisWorkbook' module, if it's 'Worksheet', it goes in the worksheet module.

Also, the code requires you to select a different cell once, so that it can set up the old address to clear the format, then it fires as expected, not perfect, but (stores the first change in the static variable, 'n')...Another way to do this may be to store the row in a worksheet cell....

Not sure why column G would give you an error...When you get the error, try hitting debug and grabbing the line of code that's conking out and posting it.

In the meantime, I'll answer the question, although I don't think this is what the problem is....<pre>
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, 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 And cl.Column<> _
7 Then cl.Interior.ColorIndex = 36
Next cl
1: Set n = Target
End Sub</pre>

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue"> Oliver</font></font></font>
This message was edited by NateO on 2002-06-20 08:02
 
Upvote 0
Thanks for the help everyone. You each did a good job, below I have posted the winning code that was submitted by one of you. When you see the code, you will know who you are. It works well. Will need to modify later, but that will be a New Post. Thanks again everyone.

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
 
Upvote 0
When one of the following letters are entered below, then the corresponding row changes to the number color; Type in e or E and you get Red and so forth. The code works great, it was from "Mudface", but cannot get a traveling row color that when it goes over an existing color that will not clear that row color. Even a reverse video color when it travels over a colored row. I don't know.
When in doubt, let the EXPERTS take a look.

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

Thanks
dennisdjones
 
Upvote 0
Hi Dennis, not sure if the target.count is going to work, are you trying to exit on a multiple cell selection? I made a few changes, I added the compare text option to streamline your code. If you want to avoid colouring rows with an exisiting colour, try the following:

<pre>
Option Explicit
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Or Target.Interior.ColorIndex <> xlNone _
Then Exit Sub
If Target = "e" Then Target.EntireRow.Interior.ColorIndex = 3
If Target = "u" Then Target.EntireRow.Interior.ColorIndex = 8
If Target = "p" Then Target.EntireRow.Interior.ColorIndex = 4
If Target = "w" Then Target.EntireRow.Interior.ColorIndex = 6
If Target = "o" Then Target.EntireRow.Interior.ColorIndex = 46
If Target = "a" Then Target.EntireRow.Interior.ColorIndex = 2
End Sub</pre>

Hope I followed your question correctly.
 
Upvote 0
On 2002-05-21 16:16, Yogi Anand wrote:
On 2002-05-21 11:48, dennisdjones wrote:
In current cell, would like to use a temporary color of the entire row that would travel up & down as I go to each cell (help to keep a better visual location of where at in the spreadsheet)

Hi dennisdjones:
I know you have plenty of information now on a VBA solution. I am proposing here a formula based CONDITIONAL FORMATTING that should meet your requirements.

Formula Is ... =and(cell("contents")<>"",row()=cell("row")) ... FORMAT|PATTERN ... color, say, green

Please keep in mind I have not tested it thoroughly -- but please report back how it behaves for you and let us take it from there.

Regards!

_________________
Yogi Anand
ANAND Enterprises
http://www.handtech.com/anand yogia@hotmail.com
This message was edited by Yogi Anand on 2002-05-21 16:36

Tried it to no avail, using the Conditional Formatting Formula As Is. Even tried selecting the entire worksheet and then using the Formatting. Appreciate the help.

dennisdjones
 
Upvote 0

Forum statistics

Threads
1,215,092
Messages
6,123,064
Members
449,090
Latest member
fragment

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top