ColorIndex and Caps Change too slow

C

ctclinesmith

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
 
G

Guest

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
 
G

Gary Keramidas

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
 
G

Gary Keramidas

forgot to capitalize your entries, add this after the 3rd line
Target.Value = UCase(Target.Value)
 
C

ctclinesmith

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.
 
G

Gary Keramidas

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
 
C

ctclinesmith

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".
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Check if Date within this week/last week 4
Find Method vs. For...Next Loop 3
Data Validation and VBA 3
Counting Criteria Values with For Loop 3
Can you improve the performance on my user defined function? 2
if statment 1
"ElseIf c.Value = "X_Clear" Then" and "...Target.Cells.Count > 1"don't work 4
Unable to set Bold property of the Font Class 4

Top