VBE Expert Help, Code linked to Cells

[Guest]

Can Code be linked to cells?
Mike H graciously created this code to change cell colors per my question
which follows:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:G10")) _
Is Nothing Then Exit Sub
Select Case Target.Value
Case "A" To "E"
icolor = 3
Case "F" To "J"
icolor = 41
Case "K" To "O"
icolor = 4
Case "P" To "T"
icolor = 6
Case Else
End Select
Target.Interior.ColorIndex = icolor
End Sub

I need a cell to change into four (4) different colors if a specific
condition is met. For example if A1 matches a text value “A thru E†I need
“redâ€, if it’s a “F thru J†then “blueâ€, “K thru O†then “greenâ€, “P thru Tâ€
then yellow.

I need to take this one step further. I have four list of high school
classes that I need to extend this to. I can type in each class (60 plus)
and assign a color in the code.
OR…..can I link the code to the list so it runs thru the list and matches
color. I my need to change/refresh the list once in a while.

Let me know if more info is needed.

Thanks
John

 

[Guest]

Hi,

I'm sure a lot of people can modify this but I'm afraid I don't understand
the question about what your further requirements are.

Mike

 

[Guest]

Mike,

Sorry for the confusion. Compared to you I am a zero when it comes to Excel.

I got your Code to work as I said. I thought I could translate your work
with the "A to E" example to a larger scale.

What I have created for my high school is a Master Schedule for all
subjects. As specific subject are entered I need them to be color coded to
help balance classes per period...ie...all periods need a good balance of
9th, 10th, 11th, & 12th grade classes. I need each level of class colored to
help me visually balance the classes.


Here are four abbreviated list of classes in the work sheet:
A B C D
1
..
..
..
25 ENG 9 ENG 10 ENG 11 ENG12
26 MATH 9 MATH 10 MATH 11 MATH 12
27 SCI 9 SCI 10 SCI 11 SCI 12


If MATH 11 is selected from a drop down menu, A1, (already created) I need
it to be highlighted with, lets say, yellow…..so I need to expand your code
so it will recognize a course description from one of the four lists and
highlights it with a designated color.

Can the code be changed to seek out the lists instead of "A" to "E" example
which I gave you.....

The current spread sheet basically has colums periods and rows with teachers
assignment (ie…MATH 11)

Did that help?

 

[Guest]

Try this and modify to your needs
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 = 3
Case "ENG 11"
icolor = 3
Case "ENG 12"
icolor = 3
Case "MATH 9"
icolor = 4
Case "MATH 10"
icolor = 4
Case "MATH 11"
icolor = 4
Case "MATH 12"
icolor = 4
Case "SCI 9"
icolor = 5
Case "SCI 10"
icolor = 5
Case "SCI 11"
icolor = 5
Case "SCI 12"
icolor = 5
Case Else
End Select
Target.Interior.ColorIndex = icolor
End Sub

 

[Guest]

or 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

 

[Guest]

Mike,

Got it. Did it.

Question??? In Sheet 1 I have cell A4 "ENG 10P" in yellow. In Sheet 2 I
linked cell D10 to cell A4 in Sheet 1. The code in Sheet 2 will change the
cell to yellow the first time I enter "ENG 10" in A4, Sheet 1. But when I
change A4, Sheet 1, to "ENG 11", red, the color in D10, Sheet 2 stays yellow
but reads "Eng 11".
Is there anyway to insure the colors change in sheet two accordingly?

When I double click the cell D10, Sheet 2, and close it, the cell will
change to the correct color. Strange?

Thanks for your help,
John

 

[Guest]

Just paste your code into sheet2 module

Mike,

Got it. Did it.

Question??? In Sheet 1 I have cell A4 "ENG 10P" in yellow. In Sheet 2 I
linked cell D10 to cell A4 in Sheet 1. The code in Sheet 2 will change the
cell to yellow the first time I enter "ENG 10" in A4, Sheet 1. But when I
change A4, Sheet 1, to "ENG 11", red, the color in D10, Sheet 2 stays yellow
but reads "Eng 11".
Is there anyway to insure the colors change in sheet two accordingly?

When I double click the cell D10, Sheet 2, and close it, the cell will
change to the correct color. Strange?

Thanks for your help,
John

 

[Guest]

I copied the code to sheet2 module. No luck though. The linked only changes
the text but the color will not automatically change when the text changes.

Thanks

 

[Guest]

I have created a work book to help you if you would like to use.
e-mail me (e-mail address removed)

 

[Guest]

Paste this into sheet1
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'only respond to changes in A1:G1 and only if
'a single cell is involved in the change -
'that restriction has to be dealt with later
'in case someone selected many cells and did a 'delete'
'
Const ControlGridStart = "A1" ' address of upper left cell
Dim alienGridStart As String ' used later, you'll see
Dim cOffset As Long ' used w/alienGridStart
Dim rOffset As Long ' used w/alienGridStart also
Dim anySheet As Worksheet
Dim iColor As Integer
Dim fColor As Integer

If Application.Intersect(Target, Range("A1:G10")) Is Nothing Then
Exit Sub
ElseIf Target.Cells.Count > 1 Then
'multiple cells changed
Exit Sub
ElseIf IsEmpty(Target) Then
'they deleted the entry! Deal with it later
'in the Worksheet_Deactivate() event
Exit Sub
End If
fColor = 0 ' black, default
Select Case UCase(Target.Value)
Case "ENG 9"
iColor = 3
Case "ENG 10"
iColor = 4
Case "ENG 11"
iColor = 5 ' dark blue
fColor = 2 ' white font
Case "ENG 12"
iColor = 6
Case "MATH 9"
iColor = 3
Case "MATH 10"
iColor = 4
Case "MATH 11"
iColor = 5
fColor = 2 ' white font
Case "MATH 12"
iColor = 6
Case "SCI 9"
iColor = 3
Case "SCI 10"
iColor = 4
Case "SCI 11"
iColor = 5
fColor = 2 ' white font
Case "SCI 12"
iColor = 6
Case Else
iColor = xlNone ' white!
End Select
'this section deals with worksheets
'that have a direct cell to cell
'link where A1 on other sheet is linked
'to A1 on this sheet...
For Each anySheet In Worksheets
Select Case anySheet.Name
'for any Case you could have multiple
'options, as
' Case "EchoControlSheetEntries","ControlSheet","SomeOtherSheet"
Case Sheet2.Name, Sheet1.Name
'this section deals with worksheets
'that have a direct cell to cell
'link where A1 on other sheet is linked
'to A1 on this sheet...
anySheet.Range(Target.Address).Interior.ColorIndex = iColor
anySheet.Range(Target.Address).Font.ColorIndex = fColor

Case Sheet1.Name
'this section deals with sheets that have the
'grid laid out the same, but set up somewhere other
'than in same address range as on the Control Sheet
'I've set up 2 variables that are offsets from A1
'the upper left cell of the offset grid
alienGridStart = "D5"
cOffset = Target.Column - Range(ControlGridStart).Column
rOffset = Target.Row - Range(ControlGridStart).Row
anySheet.Range(alienGridStart).Offset(rOffset,
cOffset).Interior.ColorIndex = iColor
anySheet.Range(Target.Address).Font.ColorIndex = fColor

Case Else
'we leave it as an exercise for the student to
'code up any situations where the values of the grid
'are scattered about on other sheets. Since there are
'80 cell addresses to deal with, I'm not going to wear
'out my fingerprints trying to cover all the bases
'in this example!!
End Select
Next ' end of anySheet loop
End Sub

Private Sub Worksheet_Deactivate()
'actually you could use this routine all by itself to deal with things
'the _Change() event handler above gives you a 'real-time' update if you
'happen to have a split window and be looking at two sheets at the same
'time, but this routine alone would actually work, it's just that the
'updates to the other sheets don't happen until you move off of this
'sheet and select another one.

'change these constants as appropriate
Const ControlGridStart = "A1" ' address of upper left cell
Const ControlGridEnd = "G10" ' address of lower right cell
Dim columnCount As Long ' in case you have really large grid
Dim rowCount As Long ' again, in case of huge grid
Dim eachColumn As Long ' loop counter
Dim eachRow As Long ' loop counter
Dim alienGridStart As String ' used later, you'll see
Dim cOffset As Long ' used w/alienGridStart
Dim rOffset As Long ' used w/alienGridStart also
Dim anySheet As Worksheet
Dim iColor As Integer ' for cell interior color
Dim fColor As Integer ' for Font Color
Dim Target As Range ' we'll steal the name!

columnCount = Range(ControlGridEnd).Column - Range(ControlGridStart).Column
rowCount = Range(ControlGridEnd).Row - Range(ControlGridStart).Row

For eachColumn = 0 To columnCount
For eachRow = 0 To rowCount
Set Target = Range(ControlGridStart).Offset(eachRow, eachColumn)
'for most cases, we'll stick with black font
fColor = 0 ' black font
Select Case UCase(Target.Value)
Case "ENG 9"
iColor = 3
Case "ENG 10"
iColor = 4
Case "ENG 11"
iColor = 5 ' dark blue
fColor = 2 ' use with white font
Case "ENG 12"
iColor = 6
Case "MATH 9"
iColor = 3
Case "MATH 10"
iColor = 4
Case "MATH 11"
iColor = 5
fColor = 2 ' use with white font
Case "MATH 12"
iColor = 6
Case "SCI 9"
iColor = 3
Case "SCI 10"
iColor = 4
Case "SCI 11"
iColor = 5
fColor = 2 ' use with white font
Case "SCI 12"
iColor = 6
Case Else
iColor = xlNone
End Select
'this section deals with worksheets
'that have a direct cell to cell
'link where A1 on other sheet is linked
'to A1 on this sheet...
For Each anySheet In Worksheets
Select Case anySheet.Name
'for any Case you could have multiple
'options, as
' Case "EchoControlSheetEntries","ControlSheet","SomeOtherSheet"
Case Sheet2.Name, Sheet1.Name
'this section deals with worksheets
'that have a direct cell to cell
'link where A1 on other sheet is linked
'to A1 on this sheet...
anySheet.Range(Target.Address).Interior.ColorIndex = iColor
anySheet.Range(Target.Address).Font.ColorIndex = fColor

Case Sheet3.Name
'this section deals with sheets that have the
'grid laid out the same, but set up somewhere other
'than in same address range as on the Control Sheet
'I've set up 2 variables that are offsets from A1
'the upper left cell of the offset grid
alienGridStart = "D5"
cOffset = Target.Column - Range(ControlGridStart).Column
rOffset = Target.Row - Range(ControlGridStart).Row
anySheet.Range(alienGridStart).Offset(rOffset,
cOffset).Interior.ColorIndex = iColor
anySheet.Range(alienGridStart).Offset(rOffset,
cOffset).Font.ColorIndex = fColor

Case Else
'we leave it as an exercise for the student to
'code up any situations where the values of the grid
'are scattered about on other sheets. Since there are
'80 cell addresses to deal with, I'm not going to wear
'out my fingerprints trying to cover all the bases
'in this example!!
End Select
Next ' end of anySheet loop
Next ' end of eachRow loop
Next ' end of eachColumn loop
End Sub

 

[Guest]

Have you got my final response

Can Code be linked to cells?
Mike H graciously created this code to change cell colors per my question
which follows:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:G10")) _
Is Nothing Then Exit Sub
Select Case Target.Value
Case "A" To "E"
icolor = 3
Case "F" To "J"
icolor = 41
Case "K" To "O"
icolor = 4
Case "P" To "T"
icolor = 6
Case Else
End Select
Target.Interior.ColorIndex = icolor
End Sub





I need to take this one step further. I have four list of high school
classes that I need to extend this to. I can type in each class (60 plus)
and assign a color in the code.
OR…..can I link the code to the list so it runs thru the list and matches
color. I my need to change/refresh the list once in a while.

Let me know if more info is needed.

Thanks
John

 

[Guest]

Did you ever get my last code??

Can Code be linked to cells?
Mike H graciously created this code to change cell colors per my question
which follows:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:G10")) _
Is Nothing Then Exit Sub
Select Case Target.Value
Case "A" To "E"
icolor = 3
Case "F" To "J"
icolor = 41
Case "K" To "O"
icolor = 4
Case "P" To "T"
icolor = 6
Case Else
End Select
Target.Interior.ColorIndex = icolor
End Sub





I need to take this one step further. I have four list of high school
classes that I need to extend this to. I can type in each class (60 plus)
and assign a color in the code.
OR…..can I link the code to the list so it runs thru the list and matches
color. I my need to change/refresh the list once in a while.

Let me know if more info is needed.

Thanks
John

 

[Guest]

Mike,

Just got back into town, 10:56pm, Monday, June 25.............I will be
digesting your responses tonight.

I will contact you asap about my progress. Thanks again