|
VBA Code; need linked cells to change color if condition met
This calls for VBA Code knowledge I dont have.
Im 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 couldnt get it to work with the example above€¦.I think this paints a better picture |
VBA Code; need linked cells to change color if condition met
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" wrote in message ... 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 |
VBA Code; need linked cells to change color if condition met
Bob,
Did you get my workbook I e-mailed? "Bob Phillips" wrote: 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" wrote in message ... 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 |
VBA Code; need linked cells to change color if condition met
Bob,
I'm getting hung up on the line" End with in the code that you sent me "Bob Phillips" wrote: 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" wrote in message ... 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 |
VBA Code; need linked cells to change color if condition met
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 JVANWORTH wrote: Bob, I'm getting hung up on the line" End with in the code that you sent me "Bob Phillips" wrote: 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" wrote in message ... 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 -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
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. "Dave Peterson" wrote: 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 JVANWORTH wrote: Bob, I'm getting hung up on the line" End with in the code that you sent me "Bob Phillips" wrote: 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" wrote in message ... 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 -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
No I didn't.
-- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "JVANWORTH" wrote in message ... Bob, Did you get my workbook I e-mailed? "Bob Phillips" wrote: 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" wrote in message ... 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 |
VBA Code; need linked cells to change color if condition met
I don't open workbooks from others.
You may want to post your existing code in plain text. JVANWORTH wrote: 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. "Dave Peterson" wrote: 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 JVANWORTH wrote: Bob, I'm getting hung up on the line" End with in the code that you sent me "Bob Phillips" wrote: 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" wrote in message ... 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 -- Dave Peterson -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
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"????? "Dave Peterson" wrote: I don't open workbooks from others. You may want to post your existing code in plain text. JVANWORTH wrote: 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. "Dave Peterson" wrote: 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 JVANWORTH wrote: Bob, I'm getting hung up on the line" End with in the code that you sent me "Bob Phillips" wrote: 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" wrote in message ... 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 -- Dave Peterson -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
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" wrote: 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 JVANWORTH wrote: Bob, I'm getting hung up on the line" End with in the code that you sent me "Bob Phillips" wrote: 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" wrote in message ... 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 -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
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. JVANWORTH wrote: 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"????? "Dave Peterson" wrote: I don't open workbooks from others. You may want to post your existing code in plain text. JVANWORTH wrote: 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. "Dave Peterson" wrote: 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 JVANWORTH wrote: Bob, I'm getting hung up on the line" End with in the code that you sent me "Bob Phillips" wrote: 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" wrote in message ... 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 -- Dave Peterson -- Dave Peterson -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
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" wrote: 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. JVANWORTH wrote: 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"????? "Dave Peterson" wrote: I don't open workbooks from others. You may want to post your existing code in plain text. JVANWORTH wrote: 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. "Dave Peterson" wrote: 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 JVANWORTH wrote: Bob, I'm getting hung up on the line" End with in the code that you sent me "Bob Phillips" wrote: 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" wrote in message ... 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) |
VBA Code; need linked cells to change color if condition met
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 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 JVANWORTH wrote: 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" wrote: 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. JVANWORTH wrote: 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"????? "Dave Peterson" wrote: I don't open workbooks from others. You may want to post your existing code in plain text. JVANWORTH wrote: 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. "Dave Peterson" wrote: 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 JVANWORTH wrote: Bob, I'm getting hung up on the line" End with in the code that you sent me "Bob Phillips" wrote: 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" wrote in message ... 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) -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
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 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 JVANWORTH wrote: 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" wrote: 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. JVANWORTH wrote: 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"????? "Dave Peterson" wrote: I don't open workbooks from others. You may want to post your existing code in plain text. JVANWORTH wrote: 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. "Dave Peterson" wrote: 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 |
VBA Code; need linked cells to change color if condition met
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 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 JVANWORTH wrote: 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" wrote: 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. JVANWORTH wrote: 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"????? "Dave Peterson" wrote: I don't open workbooks from others. You may want to post your existing code in plain text. JVANWORTH wrote: 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. "Dave Peterson" wrote: 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 -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
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 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 JVANWORTH wrote: 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" wrote: 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. JVANWORTH wrote: 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"????? "Dave Peterson" wrote: I don't open workbooks from others. |
VBA Code; need linked cells to change color if condition met
I resent it
"Bob Phillips" wrote: No I didn't. -- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "JVANWORTH" wrote in message ... Bob, Did you get my workbook I e-mailed? "Bob Phillips" wrote: 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" wrote in message ... 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 |
VBA Code; need linked cells to change color if condition met
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 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 JVANWORTH wrote: 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" wrote: 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. JVANWORTH wrote: 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"????? "Dave Peterson" wrote: I don't open workbooks from others. -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
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 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 JVANWORTH wrote: 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" wrote: 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" |
VBA Code; need linked cells to change color if condition met
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 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 JVANWORTH wrote: 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" wrote: 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" -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
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 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 JVANWORTH wrote: 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. |
VBA Code; need linked cells to change color if condition met
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 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 JVANWORTH wrote: 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. -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
I should have written:
The code still goes behind Source. That's where you're typing the changes. 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 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 JVANWORTH wrote: 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. -- Dave Peterson -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
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 |
VBA Code; need linked cells to change color if condition met
It was a struggle, but glad you got it working <bg.
JVANWORTH wrote: 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 -- Dave Peterson |
VBA Code; need linked cells to change color if condition met
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" wrote: It was a struggle, but glad you got it working <bg. JVANWORTH wrote: 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 |
VBA Code; need linked cells to change color if condition met
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. JVANWORTH wrote: 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 |
| All times are GMT +1. The time now is 02:47 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com