|
ColorIndex and Caps Change too slow
In a scheduling speadsheet I have 50 rows of employees and 365 columns
of days. After making an entry into each cell, I want to verify that the entry is one of 40 approved codes, display it in all caps, color the interior and font according to a dynamic legend that I create somewhere on the sheet (or different sheet). When I initially started this project, my color and font tests worked very well, but I have found that it gets very slow as I expanded to full range size (especially when doing the caps change line). If I can, I want to create a legend that shows what the different codes, interior shading, font colors are, and the sub will use it to do its error checking and shading. I copied much of this code from another site, but it got too slow as I added more of my needs. There is bound to be a much smarter way to get this project rolling. Please set me on a better path. Here is what I have so far: Private Sub Worksheet_Change(ByVal Target As Range) Set rng = Range("c7:dj52") For Each cl In rng cl.Value = UCase(cl.Value) If cl.Value = "AL" Then cl.Cells.Interior.ColorIndex = 3 ElseIf cl.Value = "SL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "FL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "ML" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "DL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "WL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "OL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "CL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "PL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "JD" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "X" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "HO" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "00" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "01" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "02" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "03" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "04" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "05" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "06" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "07" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "08" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "09" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 10 Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 11 Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 12 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 13 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 14 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 15 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 16 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 17 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 18 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 19 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 20 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 21 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 22 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 23 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "HO" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "T" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "<T" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "OP" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "TR" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "AD" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "MS" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "TD" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "Null" Then cl.Cells.Interior.ColorIndex = 16 cl.Cells.Font.ColorIndex = 1 Else cl.Cells.Interior.ColorIndex = 0 cl.Cells.Font.ColorIndex = 1 End If Next End Sub |
ColorIndex and Caps Change too slow
Hi,
You seem to be doing the painting of the entire range of cells when even one cell changes (as that is when the Change event is fired.) What you may like to do is to change the formatting only of the specific cell that is changed after making sure that it is within range. Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range If Not Application.Intersect(Target.Cells(1, 1), Range("A1:D20")) Is Nothing Then Set c = Target.Cells(1, 1) If c.Value = "AL" Then 'Do something ElseIf c.Value = "XX" Then 'Do something End If End If End Sub Alok " wrote: In a scheduling speadsheet I have 50 rows of employees and 365 columns of days. After making an entry into each cell, I want to verify that the entry is one of 40 approved codes, display it in all caps, color the interior and font according to a dynamic legend that I create somewhere on the sheet (or different sheet). When I initially started this project, my color and font tests worked very well, but I have found that it gets very slow as I expanded to full range size (especially when doing the caps change line). If I can, I want to create a legend that shows what the different codes, interior shading, font colors are, and the sub will use it to do its error checking and shading. I copied much of this code from another site, but it got too slow as I added more of my needs. There is bound to be a much smarter way to get this project rolling. Please set me on a better path. Here is what I have so far: Private Sub Worksheet_Change(ByVal Target As Range) Set rng = Range("c7:dj52") For Each cl In rng cl.Value = UCase(cl.Value) If cl.Value = "AL" Then cl.Cells.Interior.ColorIndex = 3 ElseIf cl.Value = "SL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "FL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "ML" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "DL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "WL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "OL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "CL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "PL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "JD" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "X" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "HO" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "00" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "01" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "02" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "03" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "04" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "05" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "06" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "07" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "08" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "09" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 10 Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 11 Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 12 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 13 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 14 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 15 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 16 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 17 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 18 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 19 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 20 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 21 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 22 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 23 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "HO" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "T" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "<T" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "OP" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "TR" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "AD" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "MS" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "TD" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "Null" Then cl.Cells.Interior.ColorIndex = 16 cl.Cells.Font.ColorIndex = 1 Else cl.Cells.Interior.ColorIndex = 0 cl.Cells.Font.ColorIndex = 1 End If Next End Sub |
ColorIndex and Caps Change too slow
sorry, posted in the wrong thread
did a search and replace and this seems to be ok. give it a try Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 Then If Not Intersect(Target, Range("c7:dj52")) Is Nothing Then If UCase(Target.Value) = "AL" Then Target.Interior.ColorIndex = 3 ElseIf UCase(Target.Value) = "SL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "FL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "ML" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "DL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "WL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "OL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "CL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "PL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "JD" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "X" Then Target.Interior.ColorIndex = 15 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "HO" Then Target.Interior.ColorIndex = 15 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "00" Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "01" Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "02" Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "03" Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "04" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "05" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "06" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "07" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "08" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "09" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 10 Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 11 Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 12 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 13 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 14 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 15 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 16 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 17 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 18 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 19 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 20 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 21 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 22 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 23 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "HO" Then Target.Interior.ColorIndex = 15 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "T" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "<T" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "OP" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "TR" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "AD" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "MS" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "TD" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "Null" Then Target.Interior.ColorIndex = 16 Target.Font.ColorIndex = 1 Else Target.Interior.ColorIndex = 0 Target.Font.ColorIndex = 1 End If End If End If End Sub -- Gary wrote in message oups.com... In a scheduling speadsheet I have 50 rows of employees and 365 columns of days. After making an entry into each cell, I want to verify that the entry is one of 40 approved codes, display it in all caps, color the interior and font according to a dynamic legend that I create somewhere on the sheet (or different sheet). When I initially started this project, my color and font tests worked very well, but I have found that it gets very slow as I expanded to full range size (especially when doing the caps change line). If I can, I want to create a legend that shows what the different codes, interior shading, font colors are, and the sub will use it to do its error checking and shading. I copied much of this code from another site, but it got too slow as I added more of my needs. There is bound to be a much smarter way to get this project rolling. Please set me on a better path. Here is what I have so far: Private Sub Worksheet_Change(ByVal Target As Range) Set rng = Range("c7:dj52") For Each cl In rng cl.Value = UCase(cl.Value) If cl.Value = "AL" Then cl.Cells.Interior.ColorIndex = 3 ElseIf cl.Value = "SL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "FL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "ML" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "DL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "WL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "OL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "CL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "PL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "JD" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "X" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "HO" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "00" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "01" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "02" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "03" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "04" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "05" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "06" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "07" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "08" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "09" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 10 Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 11 Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 12 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 13 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 14 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 15 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 16 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 17 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 18 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 19 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 20 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 21 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 22 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 23 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "HO" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "T" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "<T" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "OP" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "TR" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "AD" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "MS" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "TD" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "Null" Then cl.Cells.Interior.ColorIndex = 16 cl.Cells.Font.ColorIndex = 1 Else cl.Cells.Interior.ColorIndex = 0 cl.Cells.Font.ColorIndex = 1 End If Next End Sub |
ColorIndex and Caps Change too slow
forgot to capitalize your entries, add this after the 3rd line
Target.Value = UCase(Target.Value) -- Gary "Gary Keramidas" <GKeramidasATmsn.com wrote in message ... sorry, posted in the wrong thread did a search and replace and this seems to be ok. give it a try Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 Then If Not Intersect(Target, Range("c7:dj52")) Is Nothing Then If UCase(Target.Value) = "AL" Then Target.Interior.ColorIndex = 3 ElseIf UCase(Target.Value) = "SL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "FL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "ML" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "DL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "WL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "OL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "CL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "PL" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "JD" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "X" Then Target.Interior.ColorIndex = 15 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "HO" Then Target.Interior.ColorIndex = 15 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "00" Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "01" Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "02" Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "03" Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "04" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "05" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "06" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "07" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "08" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "09" Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 10 Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 11 Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 12 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 13 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 14 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 15 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 16 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 17 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 18 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = 19 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 20 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 21 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 22 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = 23 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "HO" Then Target.Interior.ColorIndex = 15 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "T" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "<T" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "OP" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "TR" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "AD" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "MS" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "TD" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "Null" Then Target.Interior.ColorIndex = 16 Target.Font.ColorIndex = 1 Else Target.Interior.ColorIndex = 0 Target.Font.ColorIndex = 1 End If End If End If End Sub -- Gary wrote in message oups.com... In a scheduling speadsheet I have 50 rows of employees and 365 columns of days. After making an entry into each cell, I want to verify that the entry is one of 40 approved codes, display it in all caps, color the interior and font according to a dynamic legend that I create somewhere on the sheet (or different sheet). When I initially started this project, my color and font tests worked very well, but I have found that it gets very slow as I expanded to full range size (especially when doing the caps change line). If I can, I want to create a legend that shows what the different codes, interior shading, font colors are, and the sub will use it to do its error checking and shading. I copied much of this code from another site, but it got too slow as I added more of my needs. There is bound to be a much smarter way to get this project rolling. Please set me on a better path. Here is what I have so far: Private Sub Worksheet_Change(ByVal Target As Range) Set rng = Range("c7:dj52") For Each cl In rng cl.Value = UCase(cl.Value) If cl.Value = "AL" Then cl.Cells.Interior.ColorIndex = 3 ElseIf cl.Value = "SL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "FL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "ML" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "DL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "WL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "OL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "CL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "PL" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "JD" Then cl.Cells.Interior.ColorIndex = 3 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "X" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "HO" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "00" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "01" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "02" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "03" Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "04" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "05" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "06" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "07" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "08" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "09" Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 10 Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 11 Then cl.Cells.Interior.ColorIndex = 19 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 12 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 13 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 14 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 15 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 16 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 17 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 18 Then cl.Cells.Interior.ColorIndex = 17 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = 19 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 20 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 21 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 22 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = 23 Then cl.Cells.Interior.ColorIndex = 20 cl.Cells.Font.ColorIndex = 1 ElseIf cl.Value = "HO" Then cl.Cells.Interior.ColorIndex = 15 cl.Cells.Font.ColorIndex = 2 ElseIf cl.Value = "T" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "<T" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "OP" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "TR" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "AD" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "MS" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "TD" Then cl.Cells.Interior.ColorIndex = 4 cl.Cells.Font.ColorIndex = 3 ElseIf cl.Value = "Null" Then cl.Cells.Interior.ColorIndex = 16 cl.Cells.Font.ColorIndex = 1 Else cl.Cells.Interior.ColorIndex = 0 cl.Cells.Font.ColorIndex = 1 End If Next End Sub |
ColorIndex and Caps Change too slow
Outstanding speed change!! The color and caps work great. Thank you.
The "legend" used to do error checking and to determine colors can wait until I get a better understanding of VB coding. Thanks again. |
ColorIndex and Caps Change too slow
i messed around with some arrays to see if i could shorten it a bit. test it
out Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 Then If Not Intersect(Target, Range("c7:dj52")) Is Nothing Then Target.Value = UCase(Target.Value) arr = Array("S", "F", "M", "D", "W", "O", "C", "P") If UCase(Target.Value) = "AL" Then Target.Interior.ColorIndex = 3 End If For i = LBound(arr) To UBound(arr) lStr = arr(i) & "L" If UCase(Target.Value) = lStr Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 End If Next i If UCase(Target.Value) = "JD" Then Target.Interior.ColorIndex = 3 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "X" Then Target.Interior.ColorIndex = 15 Target.Font.ColorIndex = 1 ElseIf UCase(Target.Value) = "HO" Then Target.Interior.ColorIndex = 15 Target.Font.ColorIndex = 1 End If arr2 = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9") For i = LBound(arr2) To 3 lStr2 = arr2(i) & "0" If UCase(Target.Value) = lStr2 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 End If Next i For i = 4 To UBound(arr2) lStr2 = arr2(i) & "0" If UCase(Target.Value) = lStr2 Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 End If Next i For i = 0 To 1 lStr2 = 1 & arr2(i) If UCase(Target.Value) = lStr2 Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 1 End If Next i For i = 2 To 8 lStr2 = 1 & arr2(i) If UCase(Target.Value) = lStr2 Then Target.Interior.ColorIndex = 17 Target.Font.ColorIndex = 2 End If Next i For i = 9 To 9 lStr2 = 1 & arr2(i) If UCase(Target.Value) = lStr2 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 End If Next i For i = 0 To 3 lStr2 = 2 & arr2(i) If UCase(Target.Value) = lStr2 Then Target.Interior.ColorIndex = 20 Target.Font.ColorIndex = 1 End If Next i If UCase(Target.Value) = "HO" Then Target.Interior.ColorIndex = 15 Target.Font.ColorIndex = 2 ElseIf UCase(Target.Value) = "T" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "<T" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "OP" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "TR" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "AD" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "MS" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "TD" Then Target.Interior.ColorIndex = 4 Target.Font.ColorIndex = 3 ElseIf UCase(Target.Value) = "Null" Then Target.Interior.ColorIndex = 16 Target.Font.ColorIndex = 1 Else Target.Interior.ColorIndex = 0 Target.Font.ColorIndex = 1 End If End If End If End Sub -- Gary wrote in message ups.com... Outstanding speed change!! The color and caps work great. Thank you. The "legend" used to do error checking and to determine colors can wait until I get a better understanding of VB coding. Thanks again. |
ColorIndex and Caps Change too slow
If I can figure out how to do it, I would prefer to build the array
from a "legend" on a separate worksheet named "Legend". Each approved day code, like "ML" or "08", would be on the legend with its color and font scheme. The VB code for the worksheet would look at the legend to determine if a typed day code was approved and would colorize the cell according to the legend. That way, if additional day codes are needed later, or we decide to change the color scheme for certain codes, simply changing it in the legend will accomplish the task without having to change any VB code. I hope to add a sheet called "legend" with the column 1 being the colorized day code and column 2 being the text explanation for its use, like "SL" means "Sick Leave". |
| All times are GMT +1. The time now is 10:11 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com