VBA Code runs too slow

Printable View

03-17-2009, 05:24 AM
ioncila

VBA Code runs too slow

Hi
I´m very very new in vba and i´ve made this code to run a sort of gantt chart for some projects of my own. But this macro takes about 5 minutes to run. I've search on the web for faster methods but no luck. I think the problem is in the syntax of the code. So i wish i could get some help. Thank you very much. I use Excel 2003.

Here's the code:

[VBA]
'EXECUTAR GRÁFICO GANTT
Sub GanttChart()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim ws As Worksheet
Set ws = Worksheets("PT Geral1463d")

'Gráfico Gantt
ws.Range("O21:HN494").Select
With Selection
Interior.ColorIndex = xlNone
Borders(xlDiagonalDown).LineStyle = xlNone
Borders(xlDiagonalUp).LineStyle = xlNone
Borders(xlEdgeTop).LineStyle = xlNone
Borders(xlEdgeBottom).LineStyle = xlNone
Borders(xlInsideHorizontal).LineStyle = xlNone
End With

Dim i As Integer
Dim c As Integer
Dim Sdate As Date
Dim Edate As Date

For i = 21 To 494
For c = 15 To 222

If Cells(i, 4).Value > 0 And (Cells(5, c).Value >= Cells(i, 10).Value Or _
Cells(6, c).Value >= Cells(i, 10).Value Or _
Cells(7, c).Value >= Cells(i, 10).Value Or _
Cells(8, c).Value >= Cells(i, 10).Value Or _
Cells(9, c).Value >= Cells(i, 10).Value Or _
Cells(10, c).Value >= Cells(i, 10).Value Or _
Cells(11, c).Value >= Cells(i, 10).Value) And (Cells(5, c).Value <= Cells(i, 11).Value Or _
Cells(6, c).Value <= Cells(i, 11).Value Or _
Cells(7, c).Value <= Cells(i, 11).Value Or _
Cells(8, c).Value <= Cells(i, 11).Value Or _
Cells(9, c).Value <= Cells(i, 11).Value Or _
Cells(10, c).Value <= Cells(i, 11).Value Or _
Cells(11, c).Value <= Cells(i, 11).Value) Then

Select Case Cells(i, 4)
Case 1
Cells(i, 4) = 1
Cells(i, c).Interior.ColorIndex = 11
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 11
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 11
.Weight = xlThin
End With
With Cells(i, c).Characters.Font
.ColorIndex = 11
End With
Case 2
Cells(i, 4) = 2
Cells(i, c).Interior.ColorIndex = 41
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 41
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 41
.Weight = xlThin
End With
With Cells(i, c).Characters.Font
.ColorIndex = 41
End With
Case 3
Cells(i, 4) = 3
Cells(i, c).Interior.ColorIndex = 37
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 37
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 37
.Weight = xlThin
End With
With Cells(i, c).Characters.Font
.ColorIndex = 37
End With
Case 4
Cells(i, 4) = 4
Cells(i, c).Interior.ColorIndex = 24
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 24
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 24
.Weight = xlThin
End With
With Cells(i, c).Characters.Font
.ColorIndex = 24
End With
End Select
End If
Next c
Next i

'Equipamento
ws.Range("O503:HN689").Select
With Selection
Interior.ColorIndex = xlNone
Borders(xlDiagonalDown).LineStyle = xlNone
Borders(xlDiagonalUp).LineStyle = xlNone
Borders(xlEdgeTop).LineStyle = xlNone
Borders(xlEdgeBottom).LineStyle = xlNone
Borders(xlInsideHorizontal).LineStyle = xlNone
End With

For i = 503 To 689
For c = 15 To 222

If Cells(i, 4).Value > 0 And (Cells(5, c).Value >= Cells(i, 10).Value Or _
Cells(6, c).Value >= Cells(i, 10).Value Or _
Cells(7, c).Value >= Cells(i, 10).Value Or _
Cells(8, c).Value >= Cells(i, 10).Value Or _
Cells(9, c).Value >= Cells(i, 10).Value Or _
Cells(10, c).Value >= Cells(i, 10).Value Or _
Cells(11, c).Value >= Cells(i, 10).Value) And (Cells(5, c).Value <= Cells(i, 11).Value Or _
Cells(6, c).Value <= Cells(i, 11).Value Or _
Cells(7, c).Value <= Cells(i, 11).Value Or _
Cells(8, c).Value <= Cells(i, 11).Value Or _
Cells(9, c).Value <= Cells(i, 11).Value Or _
Cells(10, c).Value <= Cells(i, 11).Value Or _
Cells(11, c).Value <= Cells(i, 11).Value) Then

Select Case Cells(i, 4)
Case 1
Cells(i, 4) = 1
Cells(i, c).Interior.ColorIndex = 11
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 11
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 11
.Weight = xlThin
End With
Case 2
Cells(i, 4) = 2
Cells(i, c).Interior.ColorIndex = 41
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 41
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 41
.Weight = xlThin
End With
Case 3
Cells(i, 4) = 3
Cells(i, c).Interior.ColorIndex = 37
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 37
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 37
.Weight = xlThin
End With
Case 4
Cells(i, 4) = 4
Cells(i, c).Interior.ColorIndex = 24
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 24
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 24
.Weight = xlThin
End With
'With Cells(i, c).Characters.Font
'.ColorIndex = 24
'End With
End Select
End If
Next c
Next i

'Mão de Obra
ws.Range("O692:HN717").Select
With Selection
Interior.ColorIndex = xlNone
Borders(xlDiagonalDown).LineStyle = xlNone
Borders(xlDiagonalUp).LineStyle = xlNone
Borders(xlEdgeTop).LineStyle = xlNone
Borders(xlEdgeBottom).LineStyle = xlNone
Borders(xlInsideHorizontal).LineStyle = xlNone
End With

For i = 692 To 717
For c = 15 To 222

If Cells(i, 4).Value > 0 And (Cells(5, c).Value >= Cells(i, 10).Value Or _
Cells(6, c).Value >= Cells(i, 10).Value Or _
Cells(7, c).Value >= Cells(i, 10).Value Or _
Cells(8, c).Value >= Cells(i, 10).Value Or _
Cells(9, c).Value >= Cells(i, 10).Value Or _
Cells(10, c).Value >= Cells(i, 10).Value Or _
Cells(11, c).Value >= Cells(i, 10).Value) And (Cells(5, c).Value <= Cells(i, 11).Value Or _
Cells(6, c).Value <= Cells(i, 11).Value Or _
Cells(7, c).Value <= Cells(i, 11).Value Or _
Cells(8, c).Value <= Cells(i, 11).Value Or _
Cells(9, c).Value <= Cells(i, 11).Value Or _
Cells(10, c).Value <= Cells(i, 11).Value Or _
Cells(11, c).Value <= Cells(i, 11).Value) Then

Select Case Cells(i, 4)
Case 1
Cells(i, 4) = 1
Cells(i, c).Interior.ColorIndex = 11
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 11
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 11
.Weight = xlThin
End With
Case 2
Cells(i, 4) = 2
Cells(i, c).Interior.ColorIndex = 41
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 41
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 41
.Weight = xlThin
End With
Case 3
Cells(i, 4) = 3
Cells(i, c).Interior.ColorIndex = 37
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 37
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 37
.Weight = xlThin
End With
Case 4
Cells(i, 4) = 4
Cells(i, c).Interior.ColorIndex = 24
With Cells(i, c).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 2
.Weight = xlThick
End With
With Cells(i, c).Borders(xlRight)
.LineStyle = xlContinuous
.ColorIndex = 24
.Weight = xlThin
End With
With Cells(i, c).Borders(xlLeft)
.LineStyle = xlContinuous
.ColorIndex = 24
.Weight = xlThin
End With

End Select
End If
Next c
Next i

Set ws = Nothing

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
[/VBA]
03-17-2009, 05:58 AM
Bob Phillips

Nested loops over that many rows and columns will take time, no matter how you tweak it.

But the design is flawed. why change everything every time? You should be using a change event just to change the affected areas. You will need to set it up once, but that minimal change as it happens.
03-17-2009, 07:18 AM
Kenneth Hobs

There is usually no need for Select or Activate.

You left out the "." for the With. Change:
[VBA] ws.Range("O21:HN494").Select
With Selection
Interior.ColorIndex = xlNone
Borders(xlDiagonalDown).LineStyle = xlNone
Borders(xlDiagonalUp).LineStyle = xlNone
Borders(xlEdgeTop).LineStyle = xlNone
Borders(xlEdgeBottom).LineStyle = xlNone
Borders(xlInsideHorizontal).LineStyle = xlNone
End With [/VBA]
to:
[VBA]
With ws.Range("O21:HN494")
.Interior.ColorIndex = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With [/VBA]
03-17-2009, 03:40 PM
ioncila

Quote:

Originally Posted by xld

Nested loops over that many rows and columns will take time, no matter how you tweak it.

But the design is flawed. why change everything every time? You should be using a change event just to change the affected areas. You will need to set it up once, but that minimal change as it happens.

Thank you for the reply. But, help me please, how do i "change event" in a way that make the macro run faster?

@Kenneth
Something ocurred in the paste of the text. The "." exists. Otherwise, the code couldn't run (i guess). Thanks anyway.

I would be very grateful if somebody would help me in the necessary changes to make it faster.

Thank you very much
03-17-2009, 04:15 PM
Bob Phillips

Well, you explain to me in business terms what triggers that formatting and I will give it a go.
03-20-2009, 04:07 PM
ioncila

After studying other suggestions i've rewriten the code and made it run in about 34 seconds, which is a very good increase of speed (more then 4 minutes in the beginning). How ever its still very slow.

So, is there a way to increase more speed?
Thanks.

Here's the new code:

'EXECUTAR GRÁFICO GANTT
Sub GanttChart()
Start = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim i As Integer, c As Integer
Dim ws As Worksheet
Set ws = Worksheets("PT Geral1463d")

'Gráfico Gantt
'This is to clear bar formats in the range
ws.Range("O21:HN494").Select
With Selection
.Interior.ColorIndex = xlNone
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 37
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 37
.Borders(xlLeft).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

For i = 21 To 494
For c = 15 To 222

If Cells(i, 4).Value = 0 Then
On Error Resume Next
ElseIf (Cells(5, c).Value >= Cells(i, 10).Value Or _
Cells(6, c).Value >= Cells(i, 10).Value Or _
Cells(7, c).Value >= Cells(i, 10).Value Or _
Cells(8, c).Value >= Cells(i, 10).Value Or _
Cells(9, c).Value >= Cells(i, 10).Value Or _
Cells(10, c).Value >= Cells(i, 10).Value Or _
Cells(11, c).Value >= Cells(i, 10).Value) And (Cells(5, c).Value <= Cells(i, 11).Value Or _
Cells(6, c).Value <= Cells(i, 11).Value Or _
Cells(7, c).Value <= Cells(i, 11).Value Or _
Cells(8, c).Value <= Cells(i, 11).Value Or _
Cells(9, c).Value <= Cells(i, 11).Value Or _
Cells(10, c).Value <= Cells(i, 11).Value Or _
Cells(11, c).Value <= Cells(i, 11).Value) Then

Select Case Cells(i, 4)
Case 1
Cells(i, c).Interior.ColorIndex = 11
With Cells(i, c)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 11
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 11
.Borders(xlLeft).Weight = xlThin
.Characters.Font.ColorIndex = 11
End With
Case 2
'Cells(i, 4) = 2
Cells(i, c).Interior.ColorIndex = 41
With Cells(i, c)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 41
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 41
.Borders(xlLeft).Weight = xlThin
.Characters.Font.ColorIndex = 41
End With
Case 3
Cells(i, c).Interior.ColorIndex = 37
With Cells(i, c)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 37
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 37
.Borders(xlLeft).Weight = xlThin
.Characters.Font.ColorIndex = 37
End With
Case 4
Cells(i, c).Interior.ColorIndex = 24
With Cells(i, c).Borders(xlEdgeTop)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 24
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 24
.Borders(xlLeft).Weight = xlThin
.Characters.Font.ColorIndex = 24
End With
End Select
End If
Next c
Next i

'Equipamento
ws.Range("O503:HN689").Select
With Selection
.Interior.ColorIndex = xlNone
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 37
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 37
.Borders(xlLeft).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

For i = 503 To 689
For c = 15 To 222

If Cells(i, 4).Value = 0 Then
On Error Resume Next
ElseIf (Cells(5, c).Value >= Cells(i, 10).Value Or _
Cells(6, c).Value >= Cells(i, 10).Value Or _
Cells(7, c).Value >= Cells(i, 10).Value Or _
Cells(8, c).Value >= Cells(i, 10).Value Or _
Cells(9, c).Value >= Cells(i, 10).Value Or _
Cells(10, c).Value >= Cells(i, 10).Value Or _
Cells(11, c).Value >= Cells(i, 10).Value) And (Cells(5, c).Value <= Cells(i, 11).Value Or _
Cells(6, c).Value <= Cells(i, 11).Value Or _
Cells(7, c).Value <= Cells(i, 11).Value Or _
Cells(8, c).Value <= Cells(i, 11).Value Or _
Cells(9, c).Value <= Cells(i, 11).Value Or _
Cells(10, c).Value <= Cells(i, 11).Value Or _
Cells(11, c).Value <= Cells(i, 11).Value) Then

Select Case Cells(i, 4)
Case 1
Cells(i, c).Interior.ColorIndex = 11
With Cells(i, c)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 11
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 11
.Borders(xlLeft).Weight = xlThin
End With
Case 2
Cells(i, c).Interior.ColorIndex = 41
With Cells(i, c)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 41
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 41
.Borders(xlLeft).Weight = xlThin
End With
Case 3
'Cells(i, 4) = 3
Cells(i, c).Interior.ColorIndex = 37
With Cells(i, c)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 37
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 37
.Borders(xlLeft).Weight = xlThin
End With
Case 4
Cells(i, c).Interior.ColorIndex = 24
With Cells(i, c)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 24
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 24
.Borders(xlLeft).Weight = xlThin
End With
End Select
End If
Next c
Next i

'Mão de Obra
ws.Range("O692:HN717").Select
With Selection
.Interior.ColorIndex = xlNone
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 37
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 37
.Borders(xlLeft).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

For i = 692 To 717
For c = 15 To 222

If Cells(i, 4).Value = 0 Then
On Error Resume Next
ElseIf (Cells(5, c).Value >= Cells(i, 10).Value Or _
Cells(6, c).Value >= Cells(i, 10).Value Or _
Cells(7, c).Value >= Cells(i, 10).Value Or _
Cells(8, c).Value >= Cells(i, 10).Value Or _
Cells(9, c).Value >= Cells(i, 10).Value Or _
Cells(10, c).Value >= Cells(i, 10).Value Or _
Cells(11, c).Value >= Cells(i, 10).Value) And (Cells(5, c).Value <= Cells(i, 11).Value Or _
Cells(6, c).Value <= Cells(i, 11).Value Or _
Cells(7, c).Value <= Cells(i, 11).Value Or _
Cells(8, c).Value <= Cells(i, 11).Value Or _
Cells(9, c).Value <= Cells(i, 11).Value Or _
Cells(10, c).Value <= Cells(i, 11).Value Or _
Cells(11, c).Value <= Cells(i, 11).Value) Then

Select Case Cells(i, 4)
Case 1
Cells(i, c).Interior.ColorIndex = 11
With Cells(i, c)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 11
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 11
.Borders(xlLeft).Weight = xlThin
End With
Case 2
Cells(i, c).Interior.ColorIndex = 41
With Cells(i, c)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 41
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 41
.Borders(xlLeft).Weight = xlThin
End With
Case 3
Cells(i, c).Interior.ColorIndex = 37
With Cells(i, c)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 37
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 37
.Borders(xlLeft).Weight = xlThin
End With
Case 4
Cells(i, c).Interior.ColorIndex = 24
With Cells(i, c)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 2
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 2
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).ColorIndex = 24
.Borders(xlRight).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).ColorIndex = 24
.Borders(xlLeft).Weight = xlThin
End With
End Select
End If
Next c
Next i

Set ws = Nothing

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox Timer - Start & " Seconds"

End Sub
03-20-2009, 04:53 PM
mdmackillop

Can you post sample data to test your code?
03-20-2009, 06:21 PM
GTO

Cross-posted: http://www.mrexcel.com/forum/showthread.php?t=378499