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" wrote:

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


JVANWORTH wrote:

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" wrote:

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.

JVANWORTH wrote:

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.
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 1 'or 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

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" wrote:

It worked for me when I tested it.

Can you create a small workbook and test it there?

JVANWORTH wrote:

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)

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 1 'or 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

"Dave Peterson" wrote:

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????

JVANWORTH wrote:

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" wrote:

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

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

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 1 'or 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