Cells.Find Causing Serious Lag

[raw4war]

Hey All,

Long time user, never posted though. Here I have about 15,000 rows of
data, all which have formulas in columns K:V. I select all of the rows
which contain a "9" in column T as the value in the cell and cut and
insert them into another sheet. The sorting is of course speedy and
the macro will eventually do it's job, but it takes a LONG time for it
to find the first cell with a "9". Since the largest value for column
T is a "9", the sort puts all of the data at the bottom of the list
which is part of the problem I'm sure. But reversing the logic will
only start the find at the bottom instead and still have to go through
the entire list. Is there a way to speed this up at all?

Dim rng As Range

Application.ScreenUpdating = False

Sheets("Summary").Rows("6:20000").Select
Selection.Sort Key1:="Pricing Bucket", Order1:=xlAscending,
Key2:="On Private List?", Order2:=xlAscending, Header:=xlYes

Range("T6").Select
Set rng = Cells.Find(What:="9", After:=ActiveCell,
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns,
SearchDirection:=xlNext, MatchCase:=False)
If rng Is Nothing Then
End
Else
Range("T6").Select
Range(Cells.Find(What:="9", After:=ActiveCell,
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns,
SearchDirection:=xlNext, MatchCase:=False).EntireRow,
ActiveCell.Offset(0, -15).End(xlDown).Offset(0, 15).EntireRow).Select
Selection.Cut
Sheets("Excluded List").Activate
Rows("7").Insert
Sheets("Summary").Activate
End If

 

[Guest]

See if this runs any faster.

 

[Guest]

Lets try that again. I hit the wrong button:

Application.ScreenUpdating = False
Sheets("Summary").Rows("6:20000").Select
Selection.Sort Key1:="Pricing Bucket", Order1:=xlAscending, Key2:="On
Private List?", Order2:=xlAscending, Header:=xlYes
lastRow = Cells(Rows.Count, 20).End(xlUp).Row
With Worksheets(1).Range("T6:T" & lastRow)
Set c = .Find(9, , LookIn:=xlValues, LookAt:=xlWhole,
SearchDirection:=xlNext)
If c Is Nothing Then
Exit Sub
Else
rng = c.Address
.Range(Cells(Range(rng).Row, 1),
Cells(Range(rng).Offset(0, -15).End(xlDown).Row, 256)).Select
Selection.Cut
Sheets("Excluded List").Activate
Rows("7").Insert
Sheets("Summary").Activate
End If
End With