Filter table and delete - code error

[thedeadzeds]

Guys,

I have found this code but i am getting error messages when running it.

lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete - this brings up and error as does ws.Activate

Thanks

[COLOR=#006CCC][FONT=Courier]Sub[/FONT][/COLOR][FONT=Courier] Delete_Rows_Based_On_Value_Table()[/FONT][FONT=Courier][COLOR=#007F00]'Apply a filter to a Table and delete visible rows[/COLOR]
[COLOR=#007F00]'Source: https://www.excelcampus.com/vba/delete-rows-cell-values/[/COLOR]

[COLOR=#006CCC]Dim[/COLOR] lo [COLOR=#006CCC]As[/COLOR] ListObject

  [COLOR=#007F00]'Set reference to the sheet and Table.[/COLOR]
  [COLOR=#006CCC]Set[/COLOR] lo = Sheet3.ListObjects(1)
  ws.Activate
  
  [COLOR=#007F00]'Clear any existing filters[/COLOR]
  lo.AutoFilter.ShowAllData
  
  [COLOR=#007F00]'1. Apply Filter[/COLOR]
  lo.Range.AutoFilter Field:=4, Criteria1:="Product 2"
  
  [COLOR=#007F00]'2. Delete Rows[/COLOR]
  Application.DisplayAlerts = [COLOR=#006CCC]False[/COLOR]
    lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
  Application.DisplayAlerts = [COLOR=#006CCC]True[/COLOR]

  [COLOR=#007F00]'3. Clear Filter[/COLOR]
  lo.AutoFilter.ShowAllData

[/FONT][COLOR=#006CCC][FONT=Courier]End[/FONT][/COLOR][COLOR=#006CCC][FONT=Courier]Sub[/FONT][/COLOR]

 

[Yongle]

Try like this instead

Sub Delete_Rows_Based_On_Value_Table() 'Apply a filter to a Table and delete visible rows
'Source: https://www.excelcampus.com/vba/delete-rows-cell-values/

    Dim lo As ListObject, ws As Worksheet
    Set ws = ActiveSheet

'Set reference to the sheet and Table.
    Set lo = ws.ListObjects(1)
      
'Clear any existing filters
    On Error Resume Next
    lo.AutoFilter.ShowAllData
    On Error GoTo 0
    
'1. Apply Filter
    lo.Range.AutoFilter Field:=4, Criteria1:="Product 2"
      
'2. Delete Rows
    Application.DisplayAlerts = False
        lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    
'3. Clear Filter
    On Error Resume Next
    lo.AutoFilter.ShowAllData
    On Error GoTo 0
End Sub

 

[thedeadzeds]

Thanks, works great until i add an array for the criteria as per below: Runtime error 1004 no cells were found? Can you help?

Many thanks

Sub Delete_Rows_Based_On_Value_Table() 'Apply a filter to a Table and delete visible rows'Source: https://www.excelcampus.com/vba/delete-rows-cell-values/


    Dim lo As ListObject, ws As Worksheet
    Set ws = ActiveSheet


'Set reference to the sheet and Table.
    Set lo = ws.ListObjects(1)
      
'Clear any existing filters
    On Error Resume Next
    lo.AutoFilter.ShowAllData
    On Error GoTo 0
    
'1. Apply Filter
    lo.Range.AutoFilter Field:=4, Criteria1:=Array("1st Attempt made", "2nd Attempt made", "3rd Attempt Made")
      
'2. Delete Rows
    Application.DisplayAlerts = False
        lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    
'3. Clear Filter
    On Error Resume Next
    lo.AutoFilter.ShowAllData
    On Error GoTo 0
End Sub

 

[Yongle]

Sub Delete_Rows_Based_On_Value_Table() 'Apply a filter to a Table and delete visible rows
'Source: https://www.excelcampus.com/vba/delete-rows-cell-values/
'now amended in several places

    Dim lo As ListObject, ws As Worksheet, [COLOR=#ff0000]arr[/COLOR]
    Set ws = ActiveSheet
    
'Set reference to the sheet and Table.
    Set lo = ws.ListObjects(1)
    [COLOR=#ff0000]arr = Array("1st Attempt made", "2nd Attempt Made", "3rd Attempt Made")[/COLOR]
      
'Clear any existing filters
    On Error Resume Next
    lo.AutoFilter.ShowAllData
    On Error GoTo 0
    
'1. Apply Filter
    lo.Range.AutoFilter Field:=4, Criteria1:=[COLOR=#ff0000]arr[/COLOR][COLOR=#800080], Operator:=xlFilterValues[/COLOR]
      
'2. Delete Rows
    Application.DisplayAlerts = False
        lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    
'3. Clear Filter
    On Error Resume Next
    lo.AutoFilter.ShowAllData
    On Error GoTo 0
End Sub