code to shade row then return it to as it was

J

Jock

This is a repeat post from yesterday which I'm still struggling with. Gary"s
Student offered some help but:
Sheet uses columns "A-AD", rows 4-10000.
Several sets of adjacent columns are shaded (visually grouped together) to
give clarity for the user.
Here's the premise:
Using a formula in column "AB", either "W", "SD", "ST" or "" will be returned.

I need code to look at column "AB" and colour the row (from "A:AD" only)
red, orange or blue for the first 3 options or leave as is for "".
This part is straightforward ChangeEvent code. However, and this is the bit
I can't fathom, if a cell in "AB" is changed from any of the 3 options back
to blank, the original cell shading needs to be re-applied.
Row 3 is the header row for all the columns, so could the fill colour from
that row be used in the code to correctly re-shade the changed row?
I can email worksheet if req'd.
Thanks
Traa Dy Liooar

Jock
 
P

Patrick Molloy

use conditional formatting
select columnds D:AD
set the 'cell value is' to 'formula is' and then the formula to

=$AD1-"W" and then set a pattern color
add two more conditions like this for the other two letter patterns

conditional formatting allows three tests, so you got lucky!
 
P

Patrick Molloy

use conditional formatting
select columnds D:AD
set the 'cell value is' to 'formula is' and then the formula to

=$AD1-"W" and then set a pattern color
add two more conditions like this for the other two letter patterns

conditional formatting allows three tests, so you got lucky!
 
J

Jock

Ideally, yes; if only it were that simple.
I've used CF on quite a few columns already to flag when a date is out of
tolerence - hence the request for code.
Thanks though, Patrick
 
R

Rick Rothstein

How did the shading in columns A:AD get into the cells... conditional
formatting or manual placed? If manually placed, is there some common item
that can be used to identify these colored cells (type of values they
contain, certain type of formula, etc.)? I don't think mapping all the
colors makes sense, so I'm looking for whatever it is that tells you to
color these cells so that code can be developed to recognize this common
element in order to reapply the colors.
 
J

Jock

Hi Rick,
colouring in the columns has been done manually. It isn't triggered by
anything, just done so to make a large worksheet easily understandable to the
user.
I suggested copying the colour format from row 3 because this is the header
row and is formatted the same as the rows beneath but this formatting will
not change whereas, any of the rows beneath could depending on what happens
in "AB".
 
R

Rick Rothstein

Okay, good... you have the columns colored as opposed to select areas...
that makes it easier. Just copy Row 3 and then use PasteSpecial to put the
copied format into the row you are removing your color from. Something like
this (where X is assumed to be your variable containing the row number being
processed)...

Rows(3).Copy
Rows(X).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Cells(X, 1).Select
 
J

Jock

Nope, can't figure it out.
You'll probably look at the code and spot the issue straight away!!
Anyway, here's what I've got:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CellColour As Variant
If Not Intersect(Target, ActiveSheet.Column("AB")) Is Nothing Then
'choose cell colour based on formula in AB
If Target.Value = "w" Then
CellColour = 3 'red
ElseIf Target.Value = "sd" Then
CellColour = 46 'orange
ElseIf Target.Value = "so" Then
CellColour = 6 'yellow
Else
[stuck here!]

End If
'colour the rows
Set myRow = Target.Offset(0, -28).Resize(, 2) 'go back to "A"
With myRow
.Interior.ColorIndex = CellColour
End With
End If
End Sub


HELP!! :0
 
P

Patrick Molloy

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CellColour As Variant
Dim correct As Range
Set correct = Intersect(Target, Range("AB:AB"))
If Not correct Is Nothing Then
'choose cell colour based on formula in AB
Select Case UCase(Target.Value)
Case "W"
CellColour = 3 'red
Case "SD"
CellColour = 46 'orange
Case "SO"
CellColour = 6 'yellow
Case Else
[stuck here!]
CellColour = xlNone
End Select
'colour the rows
With Rows(Target.Row)

.Interior.ColorIndex = CellColour
End With
End If
End Sub


Jock said:
Nope, can't figure it out.
You'll probably look at the code and spot the issue straight away!!
Anyway, here's what I've got:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CellColour As Variant
If Not Intersect(Target, ActiveSheet.Column("AB")) Is Nothing Then
'choose cell colour based on formula in AB
If Target.Value = "w" Then
CellColour = 3 'red
ElseIf Target.Value = "sd" Then
CellColour = 46 'orange
ElseIf Target.Value = "so" Then
CellColour = 6 'yellow
Else
[stuck here!]

End If
'colour the rows
Set myRow = Target.Offset(0, -28).Resize(, 2) 'go back to "A"
With myRow
.Interior.ColorIndex = CellColour
End With
End If
End Sub


HELP!! :0
--
Traa Dy Liooar

Jock


Rick Rothstein said:
Okay, good... you have the columns colored as opposed to select areas...
that makes it easier. Just copy Row 3 and then use PasteSpecial to put
the
copied format into the row you are removing your color from. Something
like
this (where X is assumed to be your variable containing the row number
being
processed)...

Rows(3).Copy
Rows(X).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Cells(X, 1).Select
 
J

Jock

Almost - when "AB" becomes blank again after having a value which coloured
the row, how do I get the code to copy row 3 and paste special to the active
row (in otherwords, rather than leaving the row with no colour, to copy the
colours from row 3).
 
R

Rick Rothstein

Try this code and see if it does what you want...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CellColour As Variant
If Not Intersect(Target, Columns("AB")) Is _
Nothing And Target.Row > 3 Then
With Range("A" & Target.Row & ":B" & Target.Row)
If Target.Value = "w" Then
.Interior.ColorIndex = 3 'red
ElseIf Target.Value = "sd" Then
.Interior.ColorIndex = 46 'orange
ElseIf Target.Value = "so" Then
.Interior.ColorIndex = 6 'yellow
Else
Range("A3:B3").Copy
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Target.Select
End If
End With
End If
End Sub

--
Rick (MVP - Excel)


Jock said:
Nope, can't figure it out.
You'll probably look at the code and spot the issue straight away!!
Anyway, here's what I've got:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CellColour As Variant
If Not Intersect(Target, ActiveSheet.Column("AB")) Is Nothing Then
'choose cell colour based on formula in AB
If Target.Value = "w" Then
CellColour = 3 'red
ElseIf Target.Value = "sd" Then
CellColour = 46 'orange
ElseIf Target.Value = "so" Then
CellColour = 6 'yellow
Else
[stuck here!]

End If
'colour the rows
Set myRow = Target.Offset(0, -28).Resize(, 2) 'go back to "A"
With myRow
.Interior.ColorIndex = CellColour
End With
End If
End Sub


HELP!! :0
--
Traa Dy Liooar

Jock


Rick Rothstein said:
Okay, good... you have the columns colored as opposed to select areas...
that makes it easier. Just copy Row 3 and then use PasteSpecial to put
the
copied format into the row you are removing your color from. Something
like
this (where X is assumed to be your variable containing the row number
being
processed)...

Rows(3).Copy
Rows(X).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Cells(X, 1).Select
 
P

Patrick Molloy

you could change CASE ELSE

Range("3:3").Copy
Rows(target.Row).PasteSpecial xlPasteFormats
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top