VBA Code; need linked cells to change color if condition met

[JVANWORTH]

This calls for VBA Code knowledge I don’t have.

I’m revisiting an old High School Scheduling project with a clearer objective.

Microsoft Office EXCEL 2003

How do I get the cells that are linked to another worksheet to change colors
if a condition is met. I will need about four colors to correspond with
approximately 15 plus conditions.

Streamlined Example Follows:

In the workbook I have two (2) worksheets named: English & Math (I will be
adding more Wrkshts as demand grows). Each has a pull down menu to assign
teachers classes for the semester.

Example of English Wrksht:
A B
1 Bicks English Art (column B selected from pull down menu)
2 Jotos 9th Lit
3 Pordan S-CAP

Math Wrksht:
A B
1 Adleman Algebra (column B selected from pull down menu)
2 Fuller Geometry
3 Johnson CAHSEE Math

And so on

In another Wrksht called Grade 9 I link up to combine English and Math to
present data in a format with color.
A B C
1 ENG Bicks English Art (cell needs blue) – (B1 & C1
link to English)
2 MATH Fuller Geometry (cell needs light green)
3 MATH Johnson CAHSEE Math (cell needs pink)
4 ENG Jotos 9th Lit (cell in light green)
5 ENG Pordon S-Cap (cell in light yellow)

As I manipulate English and Math wrkshts and change courses I need Grade 9
Wrksht to change colors. Wrkshts English and Math will not have color.

PS……Thanks to Bob, Rick “MVP”, and Toppers for your past help with code. I
just couldn’t get it to work with the example above….I think this paints a
better picture

[Bob Phillips]

Add this to the Grade 9 worksheet

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B:B" '<== change to suit

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
.Interior.ColorIndex = xlColorIndexNone

Select Case .Value

Case "Geometry": .Interior.ColorIndex = 35 'light green
Case "CAHSEE Math": .Interior.ColorIndex = 7 'pink
Case "9th Lit": .Interior.ColorIndex = 10 'green
Case "S-Cap": .Interior.ColorIndex = 36 'light yellow
'etc.
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"JVANWORTH" <JVAN...@discussions.microsoft.com> wrote in message
news:31DEF13C-0DA1-4D23...@microsoft.com...

> 1 ENG Bicks English Art (cell needs blue) - (B1 & C1

> link to English)
> 2 MATH Fuller Geometry (cell needs light green)
> 3 MATH Johnson CAHSEE Math (cell needs pink)
> 4 ENG Jotos 9th Lit (cell in light green)
> 5 ENG Pordon S-Cap (cell in light yellow)
>
> As I manipulate English and Math wrkshts and change courses I need Grade 9
> Wrksht to change colors. Wrkshts English and Math will not have color.
>
>

> PS..Thanks to Bob, Rick "MVP", and Toppers for your past help with code.
> I
> just couldn't get it to work with the example above..I think this paints
> a
> better picture
>
>

[JVANWORTH]

Bob,

Did you get my workbook I e-mailed?

[JVANWORTH]

Bob,

I'm getting hung up on the line"

End with

in the code that you sent me

[Dave Peterson]

Remember that you need an "End Select" statement, too:

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B:B" '<== change to suit

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
.Interior.ColorIndex = xlColorIndexNone

Select Case .Value

Case "Geometry": .Interior.ColorIndex = 35 'light green
Case "CAHSEE Math": .Interior.ColorIndex = 7 'pink
Case "9th Lit": .Interior.ColorIndex = 10 'green
Case "S-Cap": .Interior.ColorIndex = 36 'light yellow
'etc.

End Select '<-- added

End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

--

Dave Peterson

[JVANWORTH]

Dave,

I made the change, but still no luck with the color change. I'll keep
plugging away.
Would you mind looking at the workbook I created. I inserted windows to
give the reader an idea what I'm looking for.

[Bob Phillips]

No I didn't.

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"JVANWORTH" <JVAN...@discussions.microsoft.com> wrote in message

news:DB6B6C8E-84FA-4ABE...@microsoft.com...

[Dave Peterson]

I don't open workbooks from others.

You may want to post your existing code in plain text.

--

Dave Peterson

[JVANWORTH]

Understood

Thru this discussion I was given the following code to work with multiple
spredsheets:

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("A1:CZ800")) _
Is Nothing Then Exit Sub
Select Case UCase(Target.Value)
Case "ENG 9", "MATH 9", "SCI 9"
icolor = 3
Case "ENG 10", "MATH 10", "SCI 10"
icolor = 4
Case "ENG 11", "MATH 11", "SCI 11"
icolor = 5
Case "ENG 12", "MATH 12", "SCI 12"
icolor = 6
Case Else
End Select
Target.Interior.ColorIndex = icolor
For i = 1 To 3
With Worksheets("Sheet" & i)
For Each cell In .Range("A1: CZ800 ")
If cell.Value = Target.Value Then
cell.Interior.ColorIndex = icolor
End If
Next cell
End With
Next i

End Sub

It works really well if I only have Sheets 1, 2, 3. If I create a new sheet
called "Sch" and place 'MATH 11' in A1, then link A1 from Sheet 1 to it it
will turn blue like it should. However, if I change A1 in Sheet "Sch" to
'Math 9', A1 in Sheet 1 remains blue but says 'Math 9'. Is there any way to
get the Sheet 1 to recalculate or reprocess when I make changes in Sheet
"Sch"?????

[JVANWORTH]

Dave & Bob,

I added Daves extra line "End Select". Intial links work fine. But the
issue remains the same. When I change a cell in English or Math the linked
cell in Grade 9 will not change color (text changes, no color change)

[Dave Peterson]

Sometimes, it's not always best to loop through cells. In your case, you're
looping through A1:CZ800 (83200 cells!) -- and you're doing it 3 times.

There are faster ways to find stuff. One of those faster ways is to use .Find.

I think that this does what you want. Test it to make sure.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim iColor As Long
Dim cell As Range
Dim i As Long
Dim FoundCell As Range
Dim FirstAddress As String

'one cell at a time!
If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Range("A1:CZ800")) Is Nothing Then Exit Sub

iColor = 9999 'just an indicator

Select Case UCase(Target.Value)
Case "ENG 9", "MATH 9", "SCI 9"

iColor = 3

Case "ENG 10", "MATH 10", "SCI 10"

iColor = 4

Case "ENG 11", "MATH 11", "SCI 11"

iColor = 5

Case "ENG 12", "MATH 12", "SCI 12"

iColor = 6
Case Else
'do nothing
End Select

If iColor = 9999 Then
'do nothing
Else
Target.Interior.ColorIndex = iColor

For i = 1 To 3
With Worksheets("Sheet" & i)

With .Range("a1:CZ800")
Set FoundCell = .Cells.Find(What:=Target.Value, _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If FoundCell Is Nothing Then
'not found in that range
Else
FirstAddress = FoundCell.Address
Do
FoundCell.Interior.ColorIndex = iColor
Set FoundCell = .FindNext(after:=FoundCell)
If FoundCell.Address = FirstAddress Then
'found the first one again, get out
Exit Do
End If
Loop
End If
End With
End With
Next i
End If

End Sub

============
Since you're using xl2003, you can do Edit|Replace to change formats, too. Next
time you're in the Edit|replace dialog, click on the Options button to expand
the, er, options. You'll see that you can search by format and replace format,
too.

This will work in xl2003+ (not in earlier versions):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim iColor As Long
Dim cell As Range
Dim i As Long
Dim FoundCell As Range
Dim FirstAddress As String

'one cell at a time!
If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Range("A1:CZ800")) Is Nothing Then Exit Sub

iColor = 9999 'just an indicator

Select Case UCase(Target.Value)
Case "ENG 9", "MATH 9", "SCI 9"

iColor = 3

Case "ENG 10", "MATH 10", "SCI 10"

iColor = 4

Case "ENG 11", "MATH 11", "SCI 11"

iColor = 5

Case "ENG 12", "MATH 12", "SCI 12"

iColor = 6
Case Else
'do nothing
End Select

If iColor = 9999 Then
'do nothing
Else
Target.Interior.ColorIndex = iColor
Application.FindFormat.Clear
Application.ReplaceFormat.Clear
Application.ReplaceFormat.Interior.ColorIndex = iColor

For i = 1 To 3
With Worksheets("Sheet" & i)

With .Range("a1:CZ800")
.Cells.Replace _
What:=Target.Value, _
Replacement:=UCase(Target.Value), _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=True
End With
End With
Next i
End If
End Sub

And that second version should work pretty fast.

--

Dave Peterson

[JVANWORTH]

Dave,
Thanks for all your help and time.

The linked cell still will not change to proper color (text changes). Maybe
I should stream line the objective and move forward from there.

I deleted Sheets 2 and 3 to keep it simple. The only sheets I have are
"Sch" and "Sheet 1". "Sch" sheet will have no color.

IF A1 from "Sch" is 'Math 9' and A1 from "Sheet 1" is linked to A1 of "Sch"
your code executes for the initial linking (turns A1 in "Sheet 1" red)

If I change A1 in "Sch" to Math 10 the text in the linked cell (A1 in Sheet
1) changes but not the color.

I need to figure out how to get the workbook to do this automatically.
Somehow refresh itself.

I'll keep grinding away at it,

John

[Dave Peterson]

Try that first code that I suggested--not the code specific to xl2003.

Just to make it more clear--this worked fine for me:

For i = 1 To 1 'or 3????

End Sub

--

Dave Peterson

[JVANWORTH]

Dave,

Do I need to turn something on internally in the workbook (regeneration,
recalculation)? I can not get the linked cell to change to the correct color
when I change the source cell. The link cell will only change to the correct
color when I open it and then close it.

John

[Dave Peterson]

If you're changing the cell by typing then the Worksheet_change event should
fire and cause the other changes to take place.

If you've turned off events somewhere else (and that's consistent with your
description), you can turn events back on via:

Inside the VBE
hit ctrl-g (to see the immediate window)
type this and hit enter:
application.enableevents = true
(The test it to see if it works.)

The real problem is to find out where you turned it off and where you should
turn it back on!

Did you add something to the suggested code????

--

Dave Peterson

[JVANWORTH]

Dave,

I followed your instructions with the ctrl-g and added
"application.enableevents = true" to the immediate window, then <enter>. I
could not detect a change. The linked cell displays the new text but the
will not cahnge.

I do not believe I modified the code: (see below)

End Sub

[JVANWORTH]

I resent it

[Dave Peterson]

It worked for me when I tested it.

Can you create a small workbook and test it there?

--

Dave Peterson

[JVANWORTH]

I have created a small work book several times. Here is the procedure I used
to create the small workbook:

Open excel work book

Delete worksheet "Sheet 2". Change worksheet "Sheet 3" into "Source. and
move "Source" to the Left of "Sheet 1"

Type the following into wrksht "Source" (no code in this sheet)
A B
1 Math 9
2 Math 10
3 Math 11
4 Math 12

Copy the code you supplied on 09/02/07 into the VBA of Sheet 1.

End Sub

I link A1 of "Sheet 1" to A1 of "Source". A1 of "Sheet 1" turns Red.

Then I link A2 of "Sheet 1" to A2 of "Source". A2 of "Sheet 1" turns Green.
Same goes for A3 and A4 (assigned colors flash each time)

Next I type 'Math 9' into cells A1, A2, A3 & A4 in "Source".

When I return to "Sheet 1", cell A1 is Red 'Math 9', cell A2 is Green 'Math
9', cell A3 is Blue 'Math 9', and cell A4 is Yellow 'Math 9'.

Now I view code, ctrl-g and type: application.enableevents = true then
hit enter.

When I return to "Sheet 1" still no change.

That is how I have been testing it!

Do you see anything I might be missing?

John

[Dave Peterson]

Source is the worksheet module that should get the code. That's where you do
the manual changes, right?

And if you look at the code, you'll see these lines:

> For i = 1 To 1 'or 3????
> With Worksheets("Sheet" & i)

That's the worksheets that are being changed because of the changes made to
Source.

--

Dave Peterson

[JVANWORTH]

Dave,

"Source" is where I make the manual changes, however, I do not want color or
color changes in "Source". I only want color and color changes to happen in
"Sheet1, 2, 3,.......

Thanks for all your help,

John

[Dave Peterson]

The code still goes behind Source. That's where the changes are being made.

But this is the line that changes your target (changed cell):
Target.Interior.ColorIndex = iColor
Delete it or comment it:
'Target.Interior.ColorIndex = iColor

--

Dave Peterson

[Dave Peterson]

I should have written:
The code still goes behind Source. That's where you're typing the changes.

--

Dave Peterson

[JVANWORTH]

Dave,

That was the ticket. I got your code to work with multiple sheets. It even
works with incorporated drop down list

Now I'm going to attempt to apply the code to my existing Master Schedule
project. It's much larger in scope, but I believe your help has finally got
the color change worked out.

I will let you know how things work out as soon as possible.

I can't think you enough for your continued support and patience.

Sincerely,
John

[Dave Peterson]

It was a struggle, but glad you got it working <bg>.

--

Dave Peterson

[JVANWORTH]

Things are proceeding but slowly. Couple of questions.

I have a completed workbook that I manipulated as follows:

I have ten (10) worksheets that I use as sources:
English
Social Stud
Math
Science
Wrld Lang
PE Health
Special Ed
VPA
Career Ed
Misc

Sheet1, Sheet2, Sheet3 and Sheet4 are linked to all ten worksheets.

I pasted your modified code for source sheets into each of the ten (10)
source sheets (I added courses to the color sectiom)

Then I pasted your original code into sheets1234.

At first no cells changed colors. Then I clicked on a linked cell, hit
<enter> and all the ‘ENG 9 GEN’’ cells changed red………..as I did this with
each course. They would change to their designated color. My computer take
34 seconds to grind thru each change, but it works. When I change the
source…color changes….very nice.

Do I need to go thru and click/<enter> all the cells?

Other question:

We have three (3) different level of classes: General, College Prep and Gate
for each grade level: 9th, 10th, 11th, 12th.

Can I tweak Sheet1 so it only changes color for Freshmen General-red,
College Prep-blue and Gate-yellow classes, and so on…….. Sheet2 for
Sophomore, Sheet3 for juniors and Sheet4 for seniors?

Right now I have Sheets234 changing the same colors for all grade all
levels……..which it should do with your code

[Dave Peterson]

The code you have only runs if you make a change to the worksheet.

You could remove that requirement and make the code run on demand (maybe a
button to start it--maybe tools|macros|macro). But then it wouldn't be
automatic when you changed the data.

And you'd have to add some checks to make sure you're on the correct type of
data before you make the change.