How can I also filter out empty cell with this line?

[Romano_odK]

Good morning,

I recieved this code last week and it works great. Now I would like it to also filter empty cells. Can this be done?

Thank you for your time.

Private Sub FilterOK_Click()
  Dim tbl As ListObject
  Dim col As ListColumn
  Dim fnd As Range
 
  Set tbl = ActiveSheet.ListObjects("ItemsImport")
  Set col = tbl.ListColumns("Afwijking%" & Chr(10) & "opslag")
  Set fnd = col.Range.Find("ok", , xlValues, xlWhole, , , False)
 
  Application.ScreenUpdating = False
  If Not fnd Is Nothing Then
    tbl.Range.AutoFilter col.Index, "ok"
    tbl.DataBodyRange.EntireRow.Delete
    ActiveSheet.ShowAllData
  End If
  Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

Try this:

Private Sub FilterOK_Click()
  Dim tbl As ListObject
  Dim col As ListColumn
  Dim fnd As Range
  
  Set tbl = ActiveSheet.ListObjects("ItemsImport")
  Set col = tbl.ListColumns("Afwijking%" & Chr(10) & "Opslag")
  Set fnd = col.Range.Find("", , xlValues, xlWhole, , , False)
  
  Application.ScreenUpdating = False
  If Not fnd Is Nothing Then
    tbl.HeaderRowRange.Select
    tbl.Range.AutoFilter col.Index, ""
    tbl.DataBodyRange.EntireRow.Delete
    ActiveSheet.ShowAllData
  End If
  Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Now I would like it to also filter empty cells.

Would you want to do ok and blanks at the same time?

Private Sub FilterOK_Click_v2()
  Dim tbl As ListObject
  Dim col As ListColumn
  Dim fndok As Range, fndblank As Range
  
  Set tbl = ActiveSheet.ListObjects("ItemsImport")
  Set col = tbl.ListColumns("Afwijking%" & Chr(10) & "Opslag")
  Set fndok = col.Range.Find("ok", , xlValues, xlWhole, , , False)
  Set fndblank = col.Range.Find("", , xlValues, xlWhole, , , False)
  
  Application.ScreenUpdating = False
  If Not fndok Is Nothing Or Not fndblank Is Nothing Then
    tbl.HeaderRowRange.Select
    tbl.Range.AutoFilter col.Index, "ok", xlOr, ""
    tbl.DataBodyRange.EntireRow.Delete
    ActiveSheet.ShowAllData
  End If
  Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

If you want to delete both: empty and ok.

You can use the following:

Private Sub FilterOK_Click()
  Dim tbl As ListObject
  Dim col As ListColumn
  Dim fnd As Range
  Dim arr As Variant, ar As Variant
  
  arr = Array("", "ok")
  
  Set tbl = ActiveSheet.ListObjects("ItemsImport")
  Set col = tbl.ListColumns("Afwijking%" & Chr(10) & "Opslag")
  
  For Each ar In arr
    Set fnd = col.Range.Find(ar, , xlValues, xlWhole, , , False)
    If Not fnd Is Nothing Then Exit For
  Next
  
  Application.ScreenUpdating = False
  If Not fnd Is Nothing Then
    tbl.HeaderRowRange.Select
    tbl.Range.AutoFilter col.Index, arr, xlFilterValues
    tbl.DataBodyRange.EntireRow.Delete
    ActiveSheet.ShowAllData
  End If
  Application.ScreenUpdating = True
End Sub

This way if you want to add more items you just add them to this line, for example if you want to add closed and canceled ones:

Private Sub FilterOK_Click()
  Dim tbl As ListObject
  Dim col As ListColumn
  Dim fnd As Range
  Dim arr As Variant, ar As Variant
  
  arr = Array("", "Ok", "Closed", "Cancelled")
  
  Set tbl = ActiveSheet.ListObjects("ItemsImport")
  Set col = tbl.ListColumns("Afwijking%" & Chr(10) & "Opslag")
  
  For Each ar In arr
    Set fnd = col.Range.Find(ar, , xlValues, xlWhole, , , False)
    If Not fnd Is Nothing Then Exit For
  Next
  
  Application.ScreenUpdating = False
  If Not fnd Is Nothing Then
    tbl.HeaderRowRange.Select
    tbl.Range.AutoFilter col.Index, arr, xlFilterValues
    tbl.DataBodyRange.EntireRow.Delete
    ActiveSheet.ShowAllData
  End If
  Application.ScreenUpdating = True
End Sub

 

[Romano_odK]

If you want to delete both: empty and ok.

You can use the following:

Private Sub FilterOK_Click()
  Dim tbl As ListObject
  Dim col As ListColumn
  Dim fnd As Range
  Dim arr As Variant, ar As Variant
 
  arr = Array("", "ok")
 
  Set tbl = ActiveSheet.ListObjects("ItemsImport")
  Set col = tbl.ListColumns("Afwijking%" & Chr(10) & "Opslag")
 
  For Each ar In arr
    Set fnd = col.Range.Find(ar, , xlValues, xlWhole, , , False)
    If Not fnd Is Nothing Then Exit For
  Next
 
  Application.ScreenUpdating = False
  If Not fnd Is Nothing Then
    tbl.HeaderRowRange.Select
    tbl.Range.AutoFilter col.Index, arr, xlFilterValues
    tbl.DataBodyRange.EntireRow.Delete
    ActiveSheet.ShowAllData
  End If
  Application.ScreenUpdating = True
End Sub

This way if you want to add more items you just add them to this line, for example if you want to add closed and canceled ones:

Private Sub FilterOK_Click()
  Dim tbl As ListObject
  Dim col As ListColumn
  Dim fnd As Range
  Dim arr As Variant, ar As Variant
 
  arr = Array("", "Ok", "Closed", "Cancelled")
 
  Set tbl = ActiveSheet.ListObjects("ItemsImport")
  Set col = tbl.ListColumns("Afwijking%" & Chr(10) & "Opslag")
 
  For Each ar In arr
    Set fnd = col.Range.Find(ar, , xlValues, xlWhole, , , False)
    If Not fnd Is Nothing Then Exit For
  Next
 
  Application.ScreenUpdating = False
  If Not fnd Is Nothing Then
    tbl.HeaderRowRange.Select
    tbl.Range.AutoFilter col.Index, arr, xlFilterValues
    tbl.DataBodyRange.EntireRow.Delete
    ActiveSheet.ShowAllData
  End If
  Application.ScreenUpdating = True
End Sub

Thank you that is what I needed. Have a great day.