Filtering Excel with VBA and exiting Sub if there is no result

Question

I have some code that filters a large data set, then selects visible cells, and copy & pastes the range elsewhere.

Sub Filterstuff()
' Select & Filter data
    Sheets("Main").Select
    Lastrow = ActiveSheet.Range("A2").End(xlDown).Row
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter

' Filter for things
    ActiveSheet.Range("A1:AU" & Lastrow).AutoFilter Field:=39, Criteria1:="words"
    ActiveSheet.Range("A1:AU" & Lastrow).AutoFilter Field:=43, Criteria1:= _
        "<>*wordswords*"

' Find the first unfiltered cell
    Range("A1").Select
    ActiveCell.Offset(1, 0).Select
    Do Until ActiveCell.EntireRow.Hidden = False
        ActiveCell.Offset(1, 0).Select
    Loop

' If there are no unfiltered cells, exit
    If ActiveCell.Row = Lastrow + 1 Then
        Exit Sub

' Else paste results normally
    Else
        Range(Selection, Selection.Offset(0, 47)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        ' Paste to bottom
        Sheets("PasteSheet").Select
        countrows = Cells(Cells.Rows.Count, "A").End(xlUp).Row
        Range("A" & countrows + 1).Select
        ActiveSheet.Paste
    End If

' Return to Main and unfilter
    Sheets("Main").Select
    Cells.Select
    ActiveSheet.ShowAllData
    Selection.AutoFilter

End Sub

My issue is located in the code block meant to exit the sub if everything gets filtered out and there are no resulting rows with data after filtering. The relevant code begins at the commented section "Find the first unfiltered cell".

This code finds the first unhidden row, and checks if it is after the last row of data in the data set. My issue is that it is exceedingly slow. My data set can be 100,000+ rows and looping through it using ActiveCell.Offset(1, 0).Select takes forever.

How can I re-tool this code to exit the sub if everything gets filtered out?

Avoid using Select (this will improve the runtime performance). Then, get a handle on the full range of "data" (using second link provided), then after applying autofilter, check the range's SpecialCells(xlCellTypeVisible).Count. As long as that .Count is greater than the number of columns in your range, then you have at least one visible row of data (assuming your data has headers -- if your data has no headers, then you can just check that ..Count > 0. There is no need to loop over every cell to see if it's hidden or not by the autofilter. — David Zemens

David Zemens David Zemens · Accepted Answer · 2017-07-21T19:57:59

Avoid using Select (this will improve the runtime performance):

http://stackoverflow.com/questions/10714251

Then, get a handle on the full range of "data". Finally, after applying autofilter, check the range's SpecialCells(xlCellTypeVisible).Count.

As long as that .Count is greater than the number of columns in your range, then you have at least one visible row of data (assuming your data has headers -- if there are no headers, you can just compare whether > 0).

Untested:

Sub Filterstuff()
    ' Select & Filter data
    Dim ws as Worksheet
    Dim rng as Range

    Set ws = Worksheets("Main")
    Set rng = ws.Range("A2:AU" & ws.Range("A2").End(xlDown).Row))

    rng.AutoFilter

    ' Filter for things
    rng.AutoFilter Field:=39, Criteria1:="words"
    rng.AutoFilter Field:=43, Criteria1:="<>*wordswords*"

    ' Find the first unfiltered cell
    If rng.SpecialCells(xlCellTypeVisible).Count > rng.Columns.Count Then
        'Autofilter has returned at least one row of data
    Else
        MsgBox "No data results from Autofilter"
        Exit Sub
    End If

    <more code...>

Filtering Excel with VBA and exiting Sub if there is no result

1 Answers