CODEWITHSUNDEEP
vbaexcel
indranielgupta potta
indranielgupta potta

Reputation: 29

VBA: How to ignore Autofilter if cell reference value is blank

I am trying to filter and extract data from Sheet"Data" depending upon multiple criteria entered in a separate Sheet"Filters". However, as some of the criteria fields in Sheet"Filters" are empty, the data returned is empty. If there a way to ignore if one of the criteria entered is empty and continue with data filtering with other criteria and return data? The following is the code I wrote so far:

Sub CopyPastingFilteredData()
Dim wb As Workbook
Set wb = ActiveWorkbook
If Sheets("Data").FilterMode Then
Cells.AutoFilter
End If
'Filtering Data
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=1, Criteria1:=Sheets("Filters").Range("C4").Text
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=50, Criteria1:=Sheets("Filters").Range("C5")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=19, Criteria1:=Sheets("Filters").Range("C6")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=5, Criteria1:=Sheets("Filters").Range("C7")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=51, Criteria1:=Sheets("Filters").Range("C8")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=20, Criteria1:=Sheets("Filters").Range("C9")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=23, Criteria1:=Sheets("Filters").Range("C10")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=7, Criteria1:=Sheets("Filters").Range("C11")
'Copying Data post filtering
wb.Sheets("Data").Range("A3:BB20000").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy

wb.Sheets("Extract").Select
Cells(12, 1).PasteSpecial Paste:=xlPasteValues


Set FilterRange = Nothing
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Data").Select
Sheets("Data").Activate
Cells.AutoFilter
Sheets("Extract").Select
Sheets("Extract").Activate

End Sub

Upvotes: 0

Views: 3076

Answers (1)

Calico
Calico

Reputation: 416

You can test to see if the the cell first contains data before filtering. I have changed your Filtering Data section below

Sub CopyPastingFilteredData()
Dim wb As Workbook
Dim shF As Worksheet
Set wb = ActiveWorkbook
Set shF = wb.Sheets("Filters")
If Sheets("Data").FilterMode Then
Cells.AutoFilter
End If
'Filtering Data
With wb.Sheets("Data").Range("A2:BB20000")
    If shF.Range("C4").Value <> "" Then .AutoFilter field:=1, Criteria1:=shF.Range("C4").Text
    If shF.Range("C5").Value <> "" Then .AutoFilter field:=50, Criteria1:=shF.Range("C5")
    If shF.Range("C6").Value <> "" Then .AutoFilter field:=19, Criteria1:=shF.Range("C6")
    If shF.Range("C7").Value <> "" Then .AutoFilter field:=5, Criteria1:=shF.Range("C7")
    If shF.Range("C8").Value <> "" Then .AutoFilter field:=51, Criteria1:=shF.Range("C8")
    If shF.Range("C9").Value <> "" Then .AutoFilter field:=20, Criteria1:=shF.Range("C9")
    If shF.Range("C10").Value <> "" Then .AutoFilter field:=23, Criteria1:=shF.Range("C10")
    If shF.Range("C11").Value <> "" Then .AutoFilter field:=7, Criteria1:=shF.Range("C11")
End With
'Copying Data post filtering
wb.Sheets("Data").Range("A3:BB20000").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy

wb.Sheets("Extract").Select
Cells(12, 1).PasteSpecial Paste:=xlPasteValues


Set FilterRange = Nothing
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Data").Select
Sheets("Data").Activate
Cells.AutoFilter
Sheets("Extract").Select
Sheets("Extract").Activate

End Sub

Upvotes: 1

Related Questions