VBE Help, when linked value change, color will not

J

JVANWORTH

I have received tremendous help for the following code from Mike ( I’m
waiting for his reply, but I’m in a crunch for time so I thought I would fly
this)

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:G10")) _
Is Nothing Then Exit Sub
Select Case UCase(Target.Value)
Case "ENG 9"
icolor = 3
Case "ENG 10"
icolor = 4
Case "ENG 11"
icolor = 5
Case "ENG 12"
icolor = 6
Case "MATH 9"
icolor = 3
Case "MATH 10"
icolor = 4
Case "MATH 11"
icolor = 5
Case "MATH 12"
icolor = 6
Case "SCI 9"
icolor = 3
Case "SCI 10"
icolor = 4
Case "SCI 11"
icolor = 5
Case "SCI 12"
icolor = 6
Case Else
End Select
Target.Interior.ColorIndex = icolor
End Sub


This code will match any of the “Caseâ€s listed above for cells A1:G10, then
the code throws in the designated color for the background.

If I type “ENG 9†into A1, the cells background will change to red. (which
it should do)

If I link A10 to A1 (same sheet) the code executes perfectly the first
time. When I enter “ENG 10†into A1, A1 background becomes green (which it
should), but A10 stays red with the new text, “ENG 10†in the cell.
I need to get the links to change colors automatically. I can double click
the cell with the link and <enter> and the correct color will post up.

Is there a refresh that needs to be done?

Thanks,
John
 
T

Toppers

John,
Worksheet events are triggered by data entry: hence when you
change A1, the target cell is A1 and you get the change.

To change linked cells, code needs to be added which will loop through the
whole range and changes any cells "linked" to the target cell.
 
S

Susan

in the toolbar: tools, options
make sure your calculation is set to automatic.
one idea
:)
susan
 
T

Toppers

try:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:G10")) _
Is Nothing Then Exit Sub
Select Case UCase(Target.Value)
Case "ENG 9"
icolor = 3
Case "ENG 10"
icolor = 4
Case "ENG 11"
icolor = 5
Case "ENG 12"
icolor = 6
Case "MATH 9"
icolor = 3
Case "MATH 10"
icolor = 4
Case "MATH 11"
icolor = 5
Case "MATH 12"
icolor = 6
Case "SCI 9"
icolor = 3
Case "SCI 10"
icolor = 4
Case "SCI 11"
icolor = 5
Case "SCI 12"
icolor = 6
Case Else
End Select
Target.Interior.ColorIndex = icolor
For Each cell In Range("A1: G10 ")
If cell.Value = Target.Value Then
cell.Interior.ColorIndex = icolor
End If
Next cell
End Sub
 
R

Rick Rothstein \(MVP - VB\)

You might want to read-up on the Select Case statement in the help files in
order to become more familiar with ways in which this command can be
structured. One method, that applies to the code you posted, is the ability
to check multiple Case conditions in one Case statement block. Your Select
Case code can be shortened to this...

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

Notice how each of the conditions that returns the same value have been
grouped into a single Case statement block.

Rick
 
G

Gord Dibben

Not as short as Rick's but just one more way to deal with this.

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim rr As Range
Set r = Range("A1:G12")
If Intersect(Target, r) Is Nothing Then
Exit Sub
End If
vals = Array("Eng 9", "Eng 10", "Eng 11", "Eng 12", "Math 9", "Math 10", _
"Math 11", "Math 12", "Sc1 9", "Sci 10", "Sci 11", "Sci 12")
nums = Array(3, 4, 5, 6, 3, 4, 5, 6, 3, 4, 5, 6)
For Each rr In r
icolor = 0
For I = LBound(vals) To UBound(vals)
If rr.Value = vals(I) Then
icolor = nums(I)
End If
Next
If icolor > 0 Then
rr.Interior.ColorIndex = icolor
End If
Next
End Sub


Gord Dibben MS Excel MVP
 
R

Rick Rothstein \(MVP - VB\)

Not as short as Rick's but just one more way to deal with this.
vals = Array("Eng 9", "Eng 10", "Eng 11", "Eng 12", "Math 9", "Math 10", _
"Math 11", "Math 12", "Sc1 9", "Sci 10", "Sci 11", "Sci 12")
nums = Array(3, 4, 5, 6, 3, 4, 5, 6, 3, 4, 5, 6)
For Each rr In r
icolor = 0
For I = LBound(vals) To UBound(vals)
If rr.Value = vals(I) Then
icolor = nums(I)
End If
Next
If icolor > 0 Then
rr.Interior.ColorIndex = icolor
End If
Next
Click to expand...

If you are looking for "short"...

icolor = (Right(Target.Value, 2) - 6)

Of course, this takes advantage of the assumed meaning of the target
values... grade levels 9 through 12 with each grade having the same color no
matter what the subject area.

Rick
 
R

Rick Rothstein \(MVP - VB\)

icolor = (Right(Target.Value, 2) - 6)

Sorry, I meant to remove the outer parentheses from my test code (there was
a Val function somewhere in there originally)...

icolor = Right(Target.Value, 2) - 6

Rick
 
J

JVANWORTH

Works great but what about cells linked from sheet2 to sheet1. It didn't
change the color on sheet2 when I changed the sheet1 value. Can it be done
thru several linked sheets?

Thanks,
John
 
J

JVANWORTH

Rick,

Nice short cut for the conditions. I combined it with Toppers....

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:G10")) _
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 Each cell In Range("A1: G10 ")
If cell.Value = Target.Value Then
cell.Interior.ColorIndex = icolor
End If
Next cell
End Sub

New problem. If I link A1 from Sheet2 to A1 Sheet1 and paste the same code
to Sheet2 as is in Sheet1, A1 Sheet2 will intially change to the correct
color and text. However A1 Sheet2 will not change color (but changes text)
when I enter a different value for A1 Sheet1. How can multiple Sheets linked
to A1 Sheet1 change color and text automatically when A1 Sheet1 is change?

Thanks,
John
 
J

JVANWORTH

Gord,
Your suggestion work great. However................

"Same as I replied to Rick and Toppers"

New problem. If I link A1 from Sheet2 to A1 Sheet1 and paste the same code
to Sheet2 as is in Sheet1, A1 Sheet2 will intially change to the correct
color and text. However A1 Sheet2 will not change color (but changes text)
when I enter a different value for A1 Sheet1. How can multiple Sheets linked
to A1 Sheet1 change color and text automatically when A1 Sheet1 is change?

Thanks,
John
 
T

Toppers

Try which assumes shhets are Sheet1 and Sheet2:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:G10")) _
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 2
With Worksheets("Sheet" & i)
For Each cell In .Range("A1: G10 ")
If cell.Value = Target.Value Then
cell.Interior.ColorIndex = icolor
End If
Next cell
End With
Next i

End Sub
 
J

JVANWORTH

Toppers,

That is a sweet addition. I was able to insert it and expand it to multiple
sheets.

Your help is greatly appriciated.


John
 
R

Rick Rothstein \(MVP - VB\)

And (assuming I didn't make an error) you didn't want to implement my
ultimate code shortening formula in order to condense Toppers' code to the
following?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:G10")) Is Nothing Then Exit Sub
Target.Interior.ColorIndex = Right(Target.Value, 2) - 6
For i = 1 To 2
For Each cell In Worksheets("Sheet" & i).Range("A1:G10")
If cell.Value = Target.Value Then
cell.Interior.ColorIndex = Target.Interior.ColorIndex
End If
Next cell
Next i
End Sub

Yeah, I know, it is a little cryptic. <g>

Rick
 
J

JVANWORTH

Rick,

Your cryptic ways are beyond my skills. The list of Eng 9, Eng 10, blah
blah blah are not actual values that I separating out. I just tried to keep
questions streamlined because I'm slightly ignorant.

Thanks for your time and help,

Late,

John
 
R

Rick Rothstein \(MVP - VB\)

Your cryptic ways are beyond my skills. The list of Eng 9, Eng 10, blah
blah blah are not actual values that I separating out. I just tried to
keep
questions streamlined because I'm slightly ignorant.
Click to expand...

Okay, if Eng 9, Eng 10, etc. are not the real names being used, then that
one-liner would not work (as it was based on the exact names you posted
originally). However, you have your problem resolved, so that is what is
important. Good luck with the rest of your project.

Rick
 
J

JVANWORTH

PS....It works perfectly

Rick Rothstein (MVP - VB) said:
And (assuming I didn't make an error) you didn't want to implement my
ultimate code shortening formula in order to condense Toppers' code to the
following?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:G10")) Is Nothing Then Exit Sub
Target.Interior.ColorIndex = Right(Target.Value, 2) - 6
For i = 1 To 2
For Each cell In Worksheets("Sheet" & i).Range("A1:G10")
If cell.Value = Target.Value Then
cell.Interior.ColorIndex = Target.Interior.ColorIndex
End If
Next cell
Next i
End Sub

Yeah, I know, it is a little cryptic. <g>

Rick
Click to expand...
 
J

JVANWORTH

Rick (revisited),

Thanks for your past help.

Can I send you my completed workbook with annotations explaining what
exactly I need help with? It’s probably just a slight twist to what you
originally sent me. I just figured if you view the overall project you could
see what I was driving at. The workbook is very simple and I’m sure the code
that you suggested just needs a slight tweak.

Regards,

John
 

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

Similar Threads

Expert VBE help for cell color change 8
VBE Expert Help, Code linked to Cells 12
Auto Cell Color using VB 4
CF sheet sub modifications 3
Case Statement for Changing Font AND Background Color 11
shading cells trouble 2
if condition is met, shade cell [WORKS] but if value changes: erro 4
Undo a Worksheet_Change Event Causes run-time error '10' 0

Top