VBA - How to delete AutoFiltered rows except for the header?

[ZeePrime]

Hi,
how do I select (in VBA) all the rows that were filtered out by autofilter (using VBA code) and delete them leaving just header. I just can't figure out how to select entire rows when the data is filtered...
Thanks for your hints!

 

[Weaver]

Say your header is in row 1 and your data starts in column A

Sub test()
    Range("A2:A100").SpecialCells(xlCellTypeVisible).EntireRow.Delete
End Sub

Of course, you might have to extend the range to cover the entirity of the filtered range, but it's best to extend it at least a few rows beyond, so there's always some visible rows, otherwise the .specialcells() will error out.

HTH

 

[Weaver]

Had a thought:

Sub test()
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    If lr > 1 Then
        Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
End Sub

Might be a bit smarter, as this will do nothing if there are no rows showing.

 

[ZeePrime]

Thanks a lot - I'll give it a try! Tommorrow...

 

[WajidAzeem]

'Below is the complete program to delte only the visible filtered rows from a selected range.
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter

ActiveCell.CurrentRegion.Select 'selects the current region while activecell being one the header cells

With Selection
.AutoFilter
.AutoFilter Field:=2, Criteria1:="404665" ' filters out column2 for values 404665
.Offset(1, 0).Select 'excludes the header row from the selected range
End With

With Selection
.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'deletes all the filtered visible rows.
End With

 

[WajidAzeem]

WITH CORRECTION

Option Explicit
Sub FilterData()
    
'Below is the complete program to delte only the visible filtered rows from a selected range.
    
    If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
    
    ActiveCell.CurrentRegion.Select
    
    With Selection
        .AutoFilter
        .AutoFilter Field:=2, Criteria1:="404665"
        .Offset(1, 0).Select
    End With
    
    Dim numRows As Long, numColumns As Long
    numRows = Selection.Rows.Count
    numColumns = Selection.Columns.Count
    
    Selection.Resize(numRows - 1, numColumns).Select
    
    With Selection
  
    .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    


End Sub

 

[LAAdams17]

To delete rows that have been filtered out:

Sub DeleteFilteredOutRows()
'
' DeleteFilteredOutRows Macro
'
    Dim x As Integer, HelperC As Integer, LastRow As Integer


    'Find LastRow
    Range("A1").Select
    LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    'Add Helper Column to identify if visible
    Range("A1").Select
    Selection.End(xlToRight).Select
    ActiveCell.Offset(0, 1).Select
    HelperC = ActiveCell.Column ' HelperC = Column number of helper column
    ActiveCell.Value = "Visible?"
    
    'If visible, add 1 to Visible column
    For x = 2 To LastRow
         If Rows(x).EntireRow.Hidden Then
         Else
           Cells(x, HelperC).Value = 1
        End If
    Next x
     
    'If not visible(Visible column <> 1) then delete row
    For x = 2 To LastRow
        If Cells(x, HelperC).Value <> 1 Then
            Rows(x).EntireRow.Delete
       End If
    Next x
     
    Columns(HelperC).EntireColumn.Delete 'Delete Helper Column
    Range("A1").Select ' Select cell A1
    
    ' Removes filters
    On Error Resume Next
        ActiveSheet.ShowAllData
    
End Sub

 

[LAAdams17]

Found a bug. Here's the corrected code.

Sub DeleteFilteredOutRows()
'
' DeleteFilteredOutRows macro
'
    Dim x As Integer, HelperC As Integer, LastRow As Integer
 
    'Find LastRow
    Range("A1").Select
    LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
   
    'Add Helper Column to identify if visible
    Range("A1").Select
    Selection.End(xlToRight).Select
    ActiveCell.Offset(0, 1).Select
    HelperC = ActiveCell.Column ' HelperC = Column number of helper column
    ActiveCell.Value = "Visible?"
   
    'If visible, add 1 to Visible column
    For x = 2 To LastRow
         If Rows(x).EntireRow.Hidden Then
         Else
           Cells(x, HelperC).Value = 1
        End If
    Next x
   
    ' Removes filters
    On Error Resume Next
        ActiveSheet.ShowAllData
    
    'If not visible(Visible column <> 1) then delete row
    For x = 0 To (LastRow - 2)
        If Cells(LastRow - x, HelperC).Value <> 1 Then
            Rows(LastRow - x).EntireRow.Delete
       End If
    Next x
    
    Columns(HelperC).EntireColumn.Delete 'Delete Helper Column
    Range("A1").Select ' Select cell A1
   
End Sub

 

[sdoscher]

Thx. This helped me too.

 

[sdoscher]

This helped me a lot. Thank you.