Delete filtered data, leave headers, error

Good day, Gurus.

I have used the snippet of code below many times to delete rows of filtered data. For example, if I want to delete all rows containing "Y" in column F, this code would filter to that criteria, offset it to save the column headings, resize it to avoid deleting the row below the range, then delete the rows. This works beautifully, until I ran into an instance where there were NO "Y"'s in column F. Then it deleted the column headings.

How would I modify the code below to leave the headings in row 1, but delete any other filtered data? (Also, if there's a better way to delete filtered rows but leave headings, I would be interested.)

Thanks in advance for any help you can offer.

Range("F1").AutoFilter Field:=6, Criteria1:="Y"
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1, _
rng.Columns.Count).Delete Shift:=xlUp
ActiveSheet.AutoFilterMode = False
ActiveSheet.AutoFilterMode = False

Hello Hutch,

This macro will filter the cells if column "F" based on the criteria provided in the code. The header in cell "F1" is excluded from the filtered data. The rows of all filter matches are deleted.

Sub DeleteFilteredData()

  Dim Rng As Range
  Dim RngEnd As Range
  
   'Header in row 1
    Set Rng = Range("F1")
  'Set the filter field and criteria
    Rng.AutoFilter Field:=1, Criteria1:="Y", VisibleDropDown:=True
    
   'Exclude header from filter range
    Set Rng = Rng.Offset(1, 0)
    Set RngEnd = Cells(Rows.Count, Rng.Column).End(xlUp)
    Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Rng.Parent.Range(Rng, RngEnd))
    
   'If they are any filtered cells, delete the entire row for each filtered cell
    If Not Intersect(Rng, Rng.SpecialCells(xlCellTypeVisible)) Is Nothing Then
       Rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If

End Sub

Hello Hutch,

The Field argument is an offset, going left to right, to the column in the range to be filtered. If you filter only a single column then the field will always be 1. For column "F" to have a Field index of 6, the range would have to include column "A".

Examples

   'Single Column
    Set Rng = Range("A1:A10")
      Rng.AutoFilter Field:=1, Criteria1:="Y", VisibleDropDown:=True

    Set Rng = Range("F1:F10")
      Rng.AutoFilter Field:=1, Criteria1:="Y", VisibleDropDown:=True

   'Multiple Columns - Filter column "F"
    Set Rng = Range("A1:F10")
      Rng.AutoFilter Field:=6, Criteria1:="Y", VisibleDropDown:=True

The VisibleDropDown argument either shows (True) or hides (False) the drop down arrow for filtering.

I made a few changes to the macro, mostly to prevent errors. You can set the column you want filter in the range by changing the variable ColIndex.

Sub FilterMacro2()

  Dim ColIndex As Long
  Dim Rng As Range
  Dim RngEnd As Range
  
   'Turn off any Auto Filters
    If ActiveSheet.AutoFilterMode Then
       Range("1:1").AutoFilter
    End If
    
   'Header in row 1
    Set Rng = Range("F1")
    
   'Select the column in the range to filter (left to right)
    ColIndex = 1
    
   'Set the AutoFilter for the column and the filter value
    Rng.Columns(ColIndex).AutoFilter Field:=1, Criteria1:="Y", VisibleDropDown:=True
    
   'Exclude header from filter range
    Set Rng = Rng.Columns(ColIndex).Offset(1, 0)
    Set RngEnd = Cells(Rows.Count, Rng.Column).End(xlUp)
    Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Rng.Parent.Range(Rng, RngEnd))
    Addx = Rng.Address
    
   'If they are any filtered cells, delete the entire row for each filtered cell
    If Not Intersect(Rng, Rng.SpecialCells(xlCellTypeVisible)) Is Nothing Then
       Addx = Rng.SpecialCells(xlCellTypeVisible).Address
       Rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
       
   'Display all the data
    Rng.Parent.ShowAllData
    
End Sub