VBA Autofilter Returns No Results

[srj1359]

Hello!

I have spent hours looking online for an answer and I can't seem to find one that matches my exact situation, so I'm really hoping someone can please help. I have a pretty lengthy VBA code that is filtering data on one sheet, then copying and pasting the results onto another sheet. The two main parts of the filter are:

1. Filter all dates before or equal to today

Sheets("Quote Summary").Select
    Worksheets("Quote Summary").Unprotect "oupusa"
    If Not Worksheets("Quote Summary").Range("A8").AutoFilter Then
    Worksheets("Quote Summary").Range("A8").AutoFilter
    End If
    ActiveSheet.Range("X8").AutoFilter Field:=24, Criteria1:= _
    "<=" & Now(), Operator:=xlAnd

2. Filter all date cells after today

Sheets("Quote Summary").Select
    Worksheets("Quote Summary").Unprotect "oupusa"
    If Not Worksheets("Quote Summary").Range("A8").AutoFilter Then
    Worksheets("Quote Summary").Range("A8").AutoFilter
    End If
    ActiveSheet.Range("X8").AutoFilter Field:=24, Criteria1:= _
    ">" & Now(), Operator:=xlAnd

The headers are in row 8. The range is dynamic, so I have some coding in the copy & paste to choose the next row down from row 8.

Sheets("Quote Summary").Select
    Range("A8").Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Cells().Select
    Selection.Copy
    Sheets("Advantage Agreement Upload").Select
    Range("H25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

After each of those, I have code to copy and paste the results into a separate worksheet, copy that worksheet to a new book, then clear out the sheet in the original workbook.

The problem I'm encountering is if the filter returns no results, which will occur if there are only dates prior to today or only dates after today and not a combination of both.

Can someone please help me write in something to say if the autofilter returns no results, then do not copy and paste the data to a new sheet?

I hope that all makes sense, but please let me know if I need to clarify anything. I will be forever grateful to whoever can help. Thank you in advance!!

 

[mart37]

You can count the rows in the selection: Selection.Rows.Count
If the count < 1 then not copy

 

[srj1359]

@mart37 Thank you for your quick response!

That seems to be the answer I've seen the most in my research, I just haven't been quite sure how to apply it to my VBA.

Here's what I just made after your suggestion:

Dim lr As Long
  With Sheets("Quote Summary")
    lr = .Range("A" & Rows.count).End(3).Row
  End With

'Filter all date cells before or equal to today
  With Sheets("Quote Summary")
  lr = .Range("A" & Rows.count).End(3).Row
    Sheets("Quote Summary").Select
    Worksheets("Quote Summary").Unprotect "oupusa"
    If Not Worksheets("Quote Summary").Range("A8").AutoFilter Then
    Worksheets("Quote Summary").Range("A8").AutoFilter
    End If
    ActiveSheet.Range("X8").AutoFilter Field:=24, Criteria1:= _
    "<=" & Now(), Operator:=xlAnd
    
    If ActiveSheet.Range("A8:A" & lr).SpecialCells(xlCellTypeVisible).count < 1 Then

I'm assuming after that I just have all of my code that copies and pastes, so is after that when I would add End If or does it go right after "Then" ?

I am still new to VBA, so apologies if this is a silly question.

 

[mart37]

Maybe you can turn the condition.

If ActiveSheet.Range("A8:A" & lr).SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
your copy code
EndIf

 

[srj1359]

@mart37

When I did the first suggestion:

If ActiveSheet.Range("A8:A" & lr).SpecialCells(xlCellTypeVisible).count < 1 Then

I didn't get an error, but it also didn't copy and paste to a new sheet and workbook as it should.

When I did the second suggestion:

If ActiveSheet.Range("A8:A" & lr).SpecialCells(xlCellTypeVisible).count > 0 Then

I got "Application-defined or object-defined error" highlighting the first line of code I have in the copy process.

 

[mart37]

Maybe you can turn the condition

If ActiveSheet.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).Cells().Count > 0 Then
your copy code
End If

 

[mart37]

What is the first line?
Post more info.

 

[srj1359]

Maybe you can turn the condition.

If ActiveSheet.Range("A8:A" & lr).SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
your copy code
EndIf

This is what ended up working for me. Thanks so much, @mart37 !

 

[mart37]

Sorry, when the are no rows visible then you get a strange count of rows.
This is perhaps a better solution:

If lr > 8 Then
    c = ActiveSheet.Range("A8:A" & lr).SpecialCells(xlCellTypeVisible).Count - 1
    If c > 0 Then
        your copy code
    End If
End If