Code runs slooooww

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

The following code takes many, many minutes to run on several hundred rows.
Does anyone have any suggestions that might speed it up?

Thanks in advance!

Option Explicit

Sub tester()
Dim i As Long
Dim area As String
Dim c As Range
Const sked = "0:30"

Application.ScreenUpdating = False

For i = 3 To Cells(Rows.Count, "C").End(xlUp).Row Step 1

If Cells(i, 1).Value <> "CT" Then

area = Cells(i, "D").Value

Select Case area
Case "CR1"
For Each c In Range(Cells(i, "u"), Cells(i, "bg"))
If c.Text Like sked Then
c.Value = "CR1"
Else
c.Value = "X"
End If
Next c

Case "CR2", "CR3"
If Cells(i, "E").Value Like "*CR1*" Then
For Each c In Range(Cells(i, "u"), Cells(i, "bg"))
If c.Text Like sked Then
c.Value = "OTH"
Else
c.Value = "X"
End If
Next c
Else
Range(Cells(i, "u"), Cells(i, "bg")).Value = "X"
End If
Case Else
Cells(i, "U").Value = "X"

End Select

Else
Range(Cells(i, "u"), Cells(i, "BG")).Value = "X"
' GO TO NEXT

End If

Next i
End Sub
 
try turning calculation off right after screenupdating

Application.Calculation = xlCalculationManual

and back on at the end

Application.Calculation = xlCalculationAutomatic
 
Thanks Gary - that did the trick. It's funny because I had done this very
thing in a different part of the module, but I didn't think it would do any
good here since I'm not working with formulas. Learn something new every day
: )
 

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

Back
Top