VBA Advancedfilter: when criteria is not matched

aminex

New Member
Joined
Feb 10, 2014
Messages
39
Hello everyone,

I have a macro that Advance filter data then exported to a new workbook and it works fine, however, I would like for this workbook to not be created if the output is empty (Criteria is not matched). This would avoid getting an empty workbook that only contains headers.

Is there any way to check whether the output of advanced filter will be empty?

Thank you.

My current code is

Code:
Sub FilterData()

Dim wbName As String
Dim ThisWB As Workbook


n = Workbooks.Count


wbName = Cells(1, 3).Value
Set ThisWB = ThisWorkbook


Set NewBook = Application.Workbooks.Add(1)
NewBook.SaveAs Filename:=ThisWB.Path & "\" & wbName




ThisWB.Sheets("Caisses").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
ThisWB.Sheets("Filter").Range("A3:C4"), CopyToRange:=Workbooks(n + 1).Sheets(1).Range("A1"), Unique:=True

Columns.AutoFit


Workbooks(n + 1).Save


End Sub
 
Last edited:

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Try incorporating this code:
Code:
        Dim filteredRange As Range
        Set filteredRange = ThisWB.Sheets("Caisses").Range("A1").SpecialCells(xlCellTypeVisible)
        If filteredRange.Rows.Count > 1 Then
            'at least 1 visible data row
        End If
 
Upvote 0
Try incorporating this code:
Code:
        Dim filteredRange As Range
        Set filteredRange = ThisWB.Sheets("Caisses").Range("A1").SpecialCells(xlCellTypeVisible)
        If filteredRange.Rows.Count > 1 Then
            'at least 1 visible data row
        End If


Thank a lot, I modified it a bit but this got me going :)

Code:
Sub FilterData()


Dim wbName As String
Dim ThisWB As Workbook
Dim filteredRange As Range


n = Workbooks.Count


wbName = Cells(1, 3).Value
Set ThisWB = ThisWorkbook


Application.Workbooks.Add (1)




ThisWB.Sheets("Caisses").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
ThisWB.Sheets("Filter").Range("A3:C4"), CopyToRange:=Workbooks(n + 1).Sheets(1).Range("A1"), Unique:=True


Set filteredRange = Workbooks(n + 1).Sheets(1).Range("A1").CurrentRegion




    If filteredRange.Rows.Count > 1 Then 'at least 1 visible data row


Columns.AutoFit
Workbooks(n + 1).SaveAs Filename:=ThisWB.Path & "\" & wbName


    Else


Workbooks(n + 1).Close False
MsgBox "Criteria Not met", vbOKOnly


    End If


End Sub
 
Upvote 0

Forum statistics

Threads
1,213,513
Messages
6,114,064
Members
448,545
Latest member
kj9

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
Back
Top