Filter and delete rows that are visible.

[Romano_odK]

Good afternoon,

A while ago I go this from Peter. This works perfect in deleting the rows that are not visible. How do I change this so it will filter values that are visible?

Thank you for your time.

Romano

Private Sub CommandButton9_Click()
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  With ActiveSheet.ListObjects(1)
    .ListColumns.Add Position:=2
    On Error Resume Next
    .ListColumns(2).DataBodyRange.SpecialCells(xlVisible).Value = 1
    On Error GoTo 0
    If .Parent.FilterMode Then .Parent.ShowAllData
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=.ListColumns(2).DataBodyRange, SortOn:=xlSortOnValues, Order:=xlAscending
    .Sort.Apply
    On Error Resume Next
    .ListColumns(2).DataBodyRange.SpecialCells(xlBlanks).EntireRow.Delete
    On Error GoTo 0
    .ListColumns(2).Delete
  End With
  Application.ScreenUpdating = True
  Application.EnableEvents = False
End Sub

 

[RoryA]

You could use something like this:

Private Sub CommandButton9_Click()
   Application.EnableEvents = False
   Application.ScreenUpdating = False
   With ActiveSheet.ListObjects(1)
      Dim delRange As Range
      On Error Resume Next
      Set delRange = Intersect(.DataBodyRange, .DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible).EntireRow)
      On Error GoTo 0
      .AutoFilter.ShowAllData
   End With
   If Not delRange Is Nothing Then delRange.Delete
   Application.ScreenUpdating = True
   Application.EnableEvents = False
End Sub

 

[Romano_odK]

You could use something like this:

Private Sub CommandButton9_Click()
   Application.EnableEvents = False
   Application.ScreenUpdating = False
   With ActiveSheet.ListObjects(1)
      Dim delRange As Range
      On Error Resume Next
      Set delRange = Intersect(.DataBodyRange, .DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible).EntireRow)
      On Error GoTo 0
      .AutoFilter.ShowAllData
   End With
   If Not delRange Is Nothing Then delRange.Delete
   Application.ScreenUpdating = True
   Application.EnableEvents = False
End Sub

This indeed works, thank you and have a nice day.