VBA Autofilter Returns No Results

srj1359

New Member
Joined
Mar 5, 2015
Messages
46
Office Version
  1. 2016
Platform
  1. Windows
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

VBA Code:
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

VBA Code:
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.

VBA Code:
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!!
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
You can count the rows in the selection: Selection.Rows.Count
If the count < 1 then not copy
 

srj1359

New Member
Joined
Mar 5, 2015
Messages
46
Office Version
  1. 2016
Platform
  1. Windows
@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:

VBA Code:
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

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
Maybe you can turn the condition.
VBA Code:
If ActiveSheet.Range("A8:A" & lr).SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
your copy code
EndIf
 
Solution

srj1359

New Member
Joined
Mar 5, 2015
Messages
46
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

@mart37

When I did the first suggestion:

VBA Code:
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:

VBA Code:
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

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
Maybe you can turn the condition
VBA Code:
If ActiveSheet.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).Cells().Count > 0 Then
your copy code
End If
 

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

What is the first line?
Post more info.
 

srj1359

New Member
Joined
Mar 5, 2015
Messages
46
Office Version
  1. 2016
Platform
  1. Windows
Maybe you can turn the condition.
VBA Code:
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

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
Sorry, when the are no rows visible then you get a strange count of rows.
This is perhaps a better solution:
VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,130,112
Messages
5,640,174
Members
417,130
Latest member
Darion2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top