Speed up Color Changing

[tmo4ever]

Can anyone help with this?

I have a Gantt chart that I'm building. Since I need to have 4 color options, I can't use conditional formatting, so I'm using a great script that erik.van.geit came up with.

Is there a quicker way to have to code only make changes to each row rather than the whole range? It can take several seconds to update because of the number of cells.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim WatchRange As Range
Dim cell As Range
Dim colors As Variant
Set WatchRange = Range("k7:ip40")
colors = Array("2", "36", "50", "41", "3")

For Each cell In WatchRange
  If cell <> "" And IsNumeric(cell) Then
  cell.Interior.ColorIndex = colors(cell.Value)
  If cell.Value <> 0 Then cell.Font.ColorIndex = colors(cell.Value)
  End If
Next cell
End Sub

Any help would be great!

Thanks!

 

[just_jon]

What are the cell values you are loading into this line

cell.Interior.ColorIndex = colors(cell.Value)

 

[tmo4ever]

I'm loading a number from a drop-down. 1-4

 

[tmo4ever]

Well, I fixed the Type Mismatch question!

I still would love to find a way to speed this up!

 

[just_jon]

Colors is an array.

Is has 5 elements, colors(0) throuh colors(4)

What you need to do is simply reference the value as the index --

<font face=Courier New><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_Change(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Excel.Range)
<SPAN style="color:#00007F">Dim</SPAN> WatchRange <SPAN style="color:#00007F">As</SPAN> Range
<SPAN style="color:#00007F">Set</SPAN> WatchRange = Range("k7:ip40")
<SPAN style="color:#00007F">If</SPAN> Intersect(Target, WatchRange) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN> <SPAN style="color:#007F00">' do nothing if the change was not in K7:IP40</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range <SPAN style="color:#007F00">' avoid using names like cell which are similar/the same as reserved names in VBA</SPAN>
Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#007F00">' good practice to use this so the code will never call itself</SPAN>
Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#007F00">' will stop screen flickering, code will run faster, etc</SPAN>
<SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> Target.Cells <SPAN style="color:#007F00">' handle multi-cell changes by looping through each change in the target</SPAN>
  <SPAN style="color:#00007F">If</SPAN> c.Value >= 0 And IsNumeric(c) And c.Value <= 56 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#007F00">' also need to check for cell values > 56</SPAN>
     c.Interior.ColorIndex = c.Value <SPAN style="color:#007F00">' wasn't sure if you wanted this condition or the below or both</SPAN>
    <SPAN style="color:#007F00">' commented out the below as unclear as to intent</SPAN>
<SPAN style="color:#007F00">'    If c.Value <> 0 Then c.Font.ColorIndex = colors(c.Value)</SPAN>
  <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Next</SPAN> c
Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

A bit unclear as to exactly what you wanted, but try the above.

 

[tmo4ever]

This seems to have made everything faster, but none of my cells change color now.

 

[just_jon]

Take me through, in words, what is supposed to happen on your sheet; I'm not sure I understand exactly what needs to go on.

 

[tmo4ever]

Thanks for your help j.jon

Here is what should happen.

The user enters a start date and end date for a project. Those dates are convered into a numerical value. (I8 and J8)

A cell father down the sheet determines what number should be present

=IF(AND(T$2>=$I8,T$2<=$J8),G8)

The a drop down box assigns a numbercal value to the cell (1,2,3, or 4) - (G8)

I wnat the cell to change color based on the drop down. 1=Yellow, 2=Blue, 3=Green, 4=Red.

I have it working flawlessly based on conditional formatting, but we all know conditional formatting only allow 3 types of conditions.

 

[just_jon]

Thanks for your help j.jon

Here is what should happen.

The user enters a start date and end date for a project. Those dates are convered into a numerical value. (I8 and J8)

A cell father down the sheet determines what number should be present

=IF(AND(T$2>=$I8,T$2<=$J8),G8)

The a drop down box assigns a numbercal value to the cell (1,2,3, or 4) - (G8)

I wnat the cell to change color based on the drop down. 1=Yellow, 2=Blue, 3=Green, 4=Red.

I have it working flawlessly based on conditional formatting, but we all know conditional formatting only allow 3 types of conditions.

OK, so the formula above is in each cell wihin K7:IP40?

 

[tmo4ever]

You got it! However in the K7:IP40 is the smaller sheet. The larger sheet is (L7:IQ306)