Hello
I have created an Excel spreadsheet teachers schedule for a small school with 8 teachers. I have assigned a number to each teacher (1 - 8) so that a number typed in a cell in Column E will cause a teachers name to appear in a cell in Column G. The ranges are E3:E20 and G3:G20. I hope to find a Macro that will display each teachers name in a different color. Thank you everyone for your assistance.
Last edited by ChinaReg; 01-22-2009 at 10:23 AM.
See the code in this earlier post, you should be able to adapt it for what you need.
Hope that helps.
RoyUK
--------
If you are pleased with a member's answer then use the Star icon to rate it, if you are pleased enough to part with cash consider a donation to Children in Need
For Excel consulting, free examples and tutorials visit Excel Consulting-Excel VBA
Check out the free Excel Toolbar
New members please read & follow the Forum Rules
Remember to mark your questions Solved and rate the answer(s)
Code Tags: Make your code easier for us to read
You could use the worksheet change event. Right-click worksheet tab, view code and paste this in. It colours the cell, but be altered to font, and vary the numbers to change actual colours.
Code:Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("E3:E20")) Is Nothing Then Exit Sub Select Case Target.Value Case 1 To 8: Target.Offset(, 2).Interior.ColorIndex = Target.Value + 2 Case Else: Target.Offset(, 2).Interior.ColorIndex = 0 End Select End Sub
Last edited by StephenR; 01-21-2009 at 08:47 AM.
Thank you StephenR and RoyUk for responding so quickly. Stephen your answer is the best fit for my situation. I have a followup question if I may. Is it possible to extend the code to other columns on the same page? It works great in column E and G,but can the code be expanded to column I and K, M and O and so on? Many Thanks
I'm not sure what "and so on" might entail, but this should work up to col O:
Code:Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range If Intersect(Target, Range("E3:E20")) Is Nothing Then Exit Sub Set rng = Union(Target.Offset(, 2), Target.Offset(, 4), Target.Offset(, 6), Target.Offset(, 8), Target.Offset(, 10)) Select Case Target.Value Case 1 To 8: rng.Interior.ColorIndex = Target.Value + 2 Case Else: rng.Interior.ColorIndex = 0 End Select End Sub
Thanks again Stephen, you understood exactly what I needed and it works perfectly. This one is solved!
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
Reply With Quote
Bookmarks