Clear Auto Filter Content This works, but clears the headers also from \"table1\

Question

Clear Auto Filter Content

This works, but clears the headers also from "table1" in sheet "Client". Also need to avoid the possibility of it trying to clear content if there happens to not be any that fits the auto filter criteria. It needs the table to be selected to run the "Dim" part of the macro for some reason which may not be a problem but thought you should know. In short, I need it to not clear the header and make sure it won't error out if there happens to be no auto filtered cells to clear. Thanks!

Private Sub Workbook_Open()
     Application.ScreenUpdating = False
      
     With ActiveWorkbook.Worksheets("Prospect").ListObjects("Table14").Sort
         .SortFields.Clear
         .SortFields.Add Key:=Range("Table14[[#All],[Entry Date]]"), _
             SortOn:=xlSortOnValues, Order:=xlDescending, _
             DataOption:=xlSortTextAsNumbers
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
    
     Application.GoTo Worksheets("Prospect").Range("A1")
    
     With ActiveWorkbook.Worksheets("Vender").ListObjects("Table13").Sort
         .SortFields.Clear
         .SortFields.Add Key:=Range("Table13[[#All],[Vender]]"), _
             SortOn:=xlSortOnValues, Order:=xlAscending, _
             DataOption:=xlSortTextAsNumbers
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
     Application.GoTo Worksheets("Vender").Range("A1")
    
     With ActiveWorkbook.Worksheets("Fundraiser").ListObjects("Table15").Sort
         .SortFields.Clear
         .SortFields.Add Key:=Range("Table15[[#All],[Requestor]]"), _
             SortOn:=xlSortOnValues, Order:=xlAscending, _
             DataOption:=xlSortTextAsNumbers
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
     Application.GoTo Worksheets("Fundraiser").Range("A1")
    
     With ActiveWorkbook.Worksheets("Other").ListObjects("Table16").Sort
         .SortFields.Clear
         .SortFields.Add Key:=Range("Table16[[#All],[Contact Person]]"), _
             SortOn:=xlSortOnValues, Order:=xlAscending, _
             DataOption:=xlSortTextAsNumbers
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
     Application.GoTo Worksheets("Other").Range("A1")
    
     With ActiveWorkbook.Worksheets("Client").ListObjects("Table1").Sort
         .SortFields.Clear
         .SortFields.Add Key:=Range("Table1[[#All],[Entry Date]]"), _
             SortOn:=xlSortOnValues, Order:=xlDescending, _
             DataOption:=xlSortTextAsNumbers
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
    
    Application.GoTo Worksheets("Client").Range("B3")
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=RGB _
        (0, 0, 0), Operator:=xlFilterCellColor
    With ActiveSheet.ListObjects("Table1").AutoFilter.Filters(1).Criteria1
        .Pattern = xlGray16
        .PatternColor = 0
        .Color = 16777215
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

Dim rng As Range

Set rng = ActiveSheet.AutoFilter.Range
Set rng = rng.Resize(rng.Rows.Count - 1)

rng.ClearContents

    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1

   
     Application.GoTo Worksheets("Client").Range("A1")
    
     Application.ScreenUpdating = True
    
End Sub

Explanation / Answer

I am not sure that I am on the same wave length as you but feel free to get back to me if not what you want. I am assuming following:

You want to filter based on interior color black in field 1

You then want to set the interior pattern and color for the visible cells.

You then want to clear the data from the visible cells.

If my assumptions are correct then try the code below.

Explanation of the section code between the asterisk lines.

With ActiveSheet.AutoFilter.Range is the entire AutoFilter range including the headers, visible and non visible rows.

Set rng = .Offset(1, 0) moves the range down one to exclude the column headers. Still includes the visible and non visible rows but now includes an extra row at the bottom.

.Resize(.Rows.Count - 1, .Columns.Count) removes the extra row at the bottom that gets included by the offset.

SpecialCells(xlCellTypeVisible) excludes the non visible rows from range only includes the visible rows.

Note the comment that the code errors if only column headers are visible and hence the On Error routine and rng will be nothing if no other visible rows.

    Application.GoTo Worksheets("Client").Range("B3")
        ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=RGB _
            (0, 0, 0), Operator:=xlFilterCellColor
   
    Dim rng As Range
      
    '*****************************************************************************
    With ActiveSheet.AutoFilter.Range
        Set rng = Nothing    'Optional. Should already be nothing since just dimmed.
        On Error Resume Next
        'Following line errors if no visible data (ie. only headers visible)
        Set rng = .Offset(1, 0) _
                    .Resize(.Rows.Count - 1, .Columns.Count) _
                    .SpecialCells(xlCellTypeVisible)
    End With
    '*****************************************************************************
       
    If Not rng Is Nothing Then   'Not nothing then contains a range so some data is visible
        With rng.Interior
            .Pattern = xlGray16
            .PatternColor = 0
            .Color = 16777215
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        rng.ClearContents
    Else                            'Else is Optional code used during testing
        MsgBox "No visible data"    'Optional code used during testing
    End If

Related Questions

Navigate

• Browse (All)
• Browse C
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.