Consulting

Results 1 to 8 of 8

Thread: VBA Code runs too slow

  1. 03-17-2009, 05:24 AM #1
    ioncila
    ioncila is offline
    VBAX Contributor
    Joined
    Mar 2009
    Location
    Porto, Portugal
    Posts
    180
    Location

    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]
    Reply With Quote Reply With Quote
  2. 03-17-2009, 05:58 AM #2
    Bob Phillips
    Bob Phillips is offline
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    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.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber
    Reply With Quote Reply With Quote
  3. 03-17-2009, 07:18 AM #3
    Kenneth Hobs
    Kenneth Hobs is offline
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    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]
    Reply With Quote Reply With Quote
  4. 03-17-2009, 03:40 PM #4
    ioncila
    ioncila is offline
    VBAX Contributor
    Joined
    Mar 2009
    Location
    Porto, Portugal
    Posts
    180
    Location
    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
    Reply With Quote Reply With Quote
  5. 03-17-2009, 04:15 PM #5
    Bob Phillips
    Bob Phillips is offline
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Well, you explain to me in business terms what triggers that formatting and I will give it a go.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber
    Reply With Quote Reply With Quote
  6. 03-20-2009, 04:07 PM #6
    ioncila
    ioncila is offline
    VBAX Contributor
    Joined
    Mar 2009
    Location
    Porto, Portugal
    Posts
    180
    Location
    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
    Reply With Quote Reply With Quote
  7. 03-20-2009, 04:53 PM #7
    mdmackillop
    mdmackillop is offline
    Administrator
    VP-Knowledge Base     VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Can you post sample data to test your code?
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.

    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'
    Reply With Quote Reply With Quote
  8. 03-20-2009, 06:21 PM #8
    GTO
    GTO is offline
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    Cross-posted: http://www.mrexcel.com/forum/showthread.php?t=378499
    Reply With Quote Reply With Quote
« Previous Thread | Next Thread »

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

Forum Rules