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
