Solved: Finding 2nd instance of a colored row seems to be much slower than it should be.

[frank_m]

I wrote this routine to find colored rows, (except move on to the next if the Column A cell is colored red. - It works fine if rows are not filtered and also works ok with filtered rows unless there are alot of results. ie: 7,500 results out of 14,000 rows. - In that case it finds the first colored row ok in my sample workbook, but takes 5 seconds or more to find the 2nd colored row. Then after that other colored rows are found faster. - Is there anything I can do to improve this?

Edit: Had trouble uploading the sample file because of its size.. I managed to reduce it and now it is attached.

Option Explicit

Private Sub CommandButton1_Click()

Dim Found As Range
Dim StrtAdrss As String
Dim Rng As Range
Dim Lastrow As Long
With ActiveSheet
Lastrow = .Cells.SpecialCells(xlCellTypeVisible).Find("*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

Set Rng = .Range(.Cells(1, 1), .Cells(Lastrow, 20)).SpecialCells(xlCellTypeVisible)
End With

If ActiveCell.Column > 20 Then ActiveCell.EntireRow.Cells(1).Activate

StrtAdrss = ActiveCell.Address

Application.ScreenUpdating = False
Set Found = Rng.Find(What:="*", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not Found Is Nothing Then

'Loop Until any Colored Row is found ( except skip rows with red in Col(A)
Do Until Found.Interior.ColorIndex <> xlNone _
And Found.EntireRow.Cells(1).Interior.ColorIndex <> 3 _
And Found.Row > 15 And StrtAdrss <> Found.Address

Set Found = Rng.FindNext(Found)
Loop

ActiveWindow.ScrollRow = Found.Row 'scrolls found row to the top

Application.ScreenUpdating = True

'activate last col cell incase multiple colored cells in row, next search finds next colored row
Found.EntireRow.Cells(20).Activate

ActiveWindow.ScrollColumn = 1 ' keeps Col(A) in view when found cell is out of view

Else
MsgBox "No Match Found"

End If

End Sub

Thanks

[CatDaddy]

wrap code in the following:
Application.ScreenUpdating = false
'code
Application.ScreenUpdating = true

[snb]

Why don't you use:


Private Sub CommandButton2_Click()
Selection.AutoFilter Field:=3, Criteria1:="Test"
Selection.AutoFilter 1, "P"
End Sub

[frank_m]

Hi CatDaddy,

I already had the sigificant part of the code wrapped that way, but after your post I did try wrapping all of it, but it made no difference.

Thanks anyway..

------

Hi snb,

Rather than Filter for "P" in Column(A), I needed to filter for blank cells so that the "P" cells are filtered out instead of in.
Selection.AutoFilter 1, "="

But it's your idea conceptually, and it tripled the speed, so hats off to you for that.

Thank you Sir

:friends:

Edit: Initially this fix slowed the code down quite a lot when Col(A) is filtered for empty cells, but no other Columns are filtered.

-- I solved that by adding code to determine if any filter's are applied, If none are, the code skips the Col(A) filtering.

(edit: I realize that the solution filters out other values besides "P", that might be in Col(A).
In this case it doesn't matter because I'm looking for rows that do not contain "P" or Red in Col(A), but other Columns have some colored cells.
-- I am curious though if someone can tell me if Excel 2003 can filter for <>)

As a side note: I'm using a Userform, which makes it easy to apply the Col(A) filter when it opens and release it on Closing.
That is especially nice in my case because I need the other filters left as they were.