Code runs slooooww
 

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

Code runs slooooww
 

try turning calculation off right after screenupdating

Application.Calculation = xlCalculationManual

and back on at the end

Application.Calculation = xlCalculationAutomatic

--


Gary


"GettingThere" wrote in message
...
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

Code runs slooooww
 

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
: )

"Gary Keramidas" wrote:

try turning calculation off right after screenupdating

Application.Calculation = xlCalculationManual

and back on at the end

Application.Calculation = xlCalculationAutomatic

--


Gary


"GettingThere" wrote in message
...
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