Clear Auto Filter Content

Question

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

Answer 1

Because you were setting the pattern in the code I assumed that there would be no pattern in the cells with the black interior fill. If the cells contain the pattern when set to black then the interior fill remains even though it cannot be seen. Therefore the filter must be set to the black color and then modified to include the pattern.

I could not be certain that you will not have both combinations. ie some black without pattern and some black with pattern. Therefore I have modified the code as follows to accommodate either or both conditions.

Set filter to just black and if any visible rows then assign to rng variable.

Add the pattern to the Criteria1 filter and if any visible rows then add that to the rng variable. (At this point rng is tested for Not Nothing because if it already contains the just black range then need to use Union to add the black plus pattern range or if rng is nothing then just assign the black plus pattern range.)

Replace my previous code with the following code. Note: See my comments where I have altered the method of testing if any visible data so do not need the On Error routine.

Application.GoTo Worksheets("Client").Range("B3")

        ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=RGB _

            (0, 0, 0), Operator:=xlFilterCellColor

    Dim rng As Range    'rng initializes to Nothing when Dimmed so no need to re-initialize to Nothing

    With ActiveSheet.AutoFilter.Range

        'Test if more than 1 row (more than 1 row is more rows than just header)

        If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then

            'Assign visible data to rng

            Set rng = .Offset(1, 0) _

                        .Resize(.Rows.Count - 1, .Columns.Count) _

                        .SpecialCells(xlCellTypeVisible)

        End If

    End With

    'Reset filter to include pattern

    With ActiveSheet.ListObjects("Table1").AutoFilter.Filters(1).Criteria1

        .Pattern = xlGray16

        .PatternColor = 0

        .Color = 0

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    With ActiveSheet.AutoFilter.Range

    'Test if more than 1 row (more than 1 row is more rows than just header)

        If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then

            'Assign visible data to rng.(Add to range if rng already contains a range)

            If Not rng Is Nothing Then

                Set rng = Union(rng, .Offset(1, 0) _

                                .Resize(.Rows.Count - 1, .Columns.Count) _

                                .SpecialCells(xlCellTypeVisible))

            Else    'If rng is Nothing. ie does not contain a range.

                Set rng = .Offset(1, 0) _

                        .Resize(.Rows.Count - 1, .Columns.Count) _

                        .SpecialCells(xlCellTypeVisible)

            End If

        End If

    End With

    ActiveSheet.ShowAllData

    If Not rng Is Nothing Then   'Not nothing then contains a range

        With rng.Interior

            .Pattern = xlGray16

            .PatternColor = 0

            .Color = 16777215

            .TintAndShade = 0

            .PatternTintAndShade = 0

        End With

        rng.ClearContents

    Else                            'Optional code used during testing. Can be deleted after testing

        MsgBox "No visible data"    'Optional code used during testing. Can be deleted after testing

    End If

  '  ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1    'Not required. ShowAllData above

Answer 2

Here is the link.  Thanks!  http://1drv.ms/1wjVWMS

Answer 3

It is not erasing the headers, but pops up the message "No visible data".  I have an entry that fits the Auto Filter criteria, but it is not recognizing it there.  So far, I don't see that it is clearing the content of any.       

Please confirm that the following (as per my previous post) is an accurate description of what you want to do?

1. You want to filter based on interior color black in field 1
2. You then want to set the interior pattern and color for the visible cells.
3. You then want to clear the data from the visible cells.

If it is what you want then if no visible data then it appears that the criteria is not matched. Are you able to set the filter manually based on the interior color of the cells and if you record the code while doing so, does the recorded code match the code in my example?

If you can't get it working do you have any sensitive data in the workbook because if not can you post a copy on OneDrive. If you have sensitive data that you cannot share can you make a copy of the workbook with some dummy data.

Guidelines to post a workbook on OneDrive

1. Zip your workbook. I prefer that you do not just save to OneDrive. (To Zip a file, in Windows Explorer  Right click on the selected file and select Send to -> Compressed (zipped) folder.)
2. Go to this link.  https://onedrive.live.com
3. Use the same login Id and Password that you use for this forum.
4. Select Upload in the blue bar across the top and browse to the zipped folder to be uploaded and select Open (or just double click). (Be patient and give it time to display the file after initially seeing the popup indicating it is done.)
5. Right click the file on OneDrive and select Share.
6. Do NOT fill in the form; "Select Get a Link" on the left side.
7. Click the button "Create a Link"
8. Click in the box where the link is created and it will highlight.
9. Copy the link and paste into your reply on this forum.

Answer 4

It is not erasing the headers, but pops up the message "No visible data".  I have an entry that fits the Auto Filter criteria, but it is not recognizing it there.  So far, I don't see that it is clearing the content of any.

Answer 5

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