locked
vba to deselect items in autofilter RRS feed

  • Question

  • been looking but haven't found anything. would like to use vba with autofilter to 'deselect' 3 specific items in a range

    "0","remove" and " "(blanks). can this be done. 

     thanks

    Doug

    Friday, May 10, 2019 7:04 PM

Answers

  • My previous reply was not correct due to my initial miss-interpretation of your question and therefore I deleted it.

    The following code does the following:

    1. Copies a list of all the data in the column to be filtered and pastes it into a column to another blank worksheet
    2. In the pasted list, replaces the values that are not to be visible when AutoFilter is applied
    3. Removes the Duplicates to create a Unique list of values to remain visible
    4. Sorts the list so that blanks go to the bottom of the list.
    5. Assigns the list a an array
    6. Creates a new array with string values replacing any numeric values in the list
    7. Uses the string array to set the filter with Operator:=xlFilterValues

    I have comments where you will need to edit the code to suit your requirements (eg. Worksheet names and column to be filtered).

    When applying VBA code, it is advisable to ensure that you have a backup copy of your workbook in case something goes wrong.

    Code example below.

    Sub Macro1()
        Dim wsOne As Worksheet
        Dim wsFiltList As Worksheet
        Dim rngColToFilter As Range
        Dim rngUnique As Range
        Dim rngToSort As Range
        Dim arrUnique As Variant
        Dim i As Long
        
        Set wsOne = Worksheets("Sheet1")        'Worksheet containing the Autofilter range
        'Edit "Sheet2" in the following line to a worksheet that is not used for anything else.
        Set wsFiltList = Worksheets("Sheet2")        'Used to create Filter List for column to have AutoFilter applied
        
        With wsOne
            If .AutoFilterMode Then     'If Autofilter is on
                If .FilterMode Then     'If any filters set
                    .ShowAllData
                End If
            Else
                'AutoFilter not on so set AutoFilter based on all all column headers in row 1
                .Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft)).AutoFilter
            End If
            
            Set rngColToFilter = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp)) 'Edit "A" to the column to be filtered
        End With
        
        With wsFiltList
            .Columns("A:A").Clear       'Clear the column in the temporary sheet
            rngColToFilter.Copy Destination:=.Cells(1, 1)   'copy the column to another worksheet\
             Set rngUnique = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp)) 'Assign column of data to a variable
            
            'Replace zeros with null string (or blank)
            rngUnique.Replace What:="0", _
                                Replacement:="", _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False, _
                                SearchFormat:=False, _
                                ReplaceFormat:=False
                                
            'Replace "Remove" with null string (or blank)
            rngUnique.Replace What:="remove", _
                                Replacement:="", _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False, _
                                SearchFormat:=False, _
                                ReplaceFormat:=False
            
            'No need to replace blanks because sort will remove them
            
            'Remove duplicates
            .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlYes
            
            'Sort to move blanks to bottom of list
            With wsFiltList
                .Sort.SortFields.Clear
                .Sort.SortFields.Add Key:=.Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp)), _
                                SortOn:=xlSortOnValues, _
                                Order:=xlAscending, _
                                DataOption:=xlSortNormal
                                
                Set rngToSort = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
            End With
            
            With wsFiltList.Sort
                .SetRange rngToSort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            'Re-assign the remaining data to the rngUnique range variable.
            Set rngUnique = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp)) 'Unique list of data (Excludes column header)
            
            arrUnique = rngUnique.Value 'Assign the unique list to an array
            
            For i = LBound(arrUnique) To UBound(arrUnique)
                arrUnique(i, 1) = CStr(arrUnique(i, 1)) 'Convert numeric values in array to strings for Autofilter
            Next i
            
        End With
            
        'Must transose the array for use in AutoFilter
        wsOne.AutoFilter.Range.AutoFilter Field:=1, Criteria1:=Application.Transpose(arrUnique), Operator:=xlFilterValues
        
    End Sub
    

    Regards, OssieMac

    • Marked as answer by 6da4 Monday, May 13, 2019 6:41 PM
    Saturday, May 11, 2019 4:20 AM