Multiple cells AutoFilter

Question

I have a code that selects non empty cells in column C. Now If I want to select these cells in my autofilter it only pics the first found value of OutRng. How do i fix this?

Sub SelectNonBlankCells()

    Sheets("Rekenblad").Select

    Dim Rng As Range
    Dim OutRng As Range
    Dim xTitle As String
    SearchCol = "10"

    On Error Resume Next

    xTitle = Range("C:C")
    Set InputRng = Range("C:C")

    For Each Rng In InputRng
        If Not Rng.Value = "" Then
            If OutRng Is Nothing Then
                Set OutRng = Rng
            Else
                Set OutRng = Application.Union(OutRng, Rng)
            End If
        End If
    Next

    If Not (OutRng Is Nothing) Then
        OutRng.Copy

        Sheets("Plakken").Select
        ActiveSheet.Range("$A$1:$K$13").AutoFilter Field:=10, Criteria1:=Array(OutRng) _
            , Operator:=xlFilterValues
    End If
End Sub

First you need to remove `On Error Resume Next` this line is evil. It hides **all** your error messages but the errors still occur, you just cannot see them. If you cannot see tham you cannot fix them and if you don't fix them your code can obviously not work properly. Remove that line and if interested in error handling read [VBA Error Handling – A Complete Guide](https://excelmacromastery.com/vba-error-handling). — Pᴇʜ, Nov 08 '21 at 16:17
You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — Pᴇʜ, Nov 08 '21 at 16:21

VBasic2008 · Accepted Answer · 2021-11-08T18:23:00.253

AutoFilter on Multiple (an Array of) Values

Range("C:C") is quite a huge range and it could take ages to get processed.
OutRng.Copy makes no sense unless you plan to copy it somewhere.
Since OutRng is declared as a range, Array(OutRng) is an array containing one element which is the actual range (object, not values).
If a range contains more than one cell and is contiguous (a single range, one area), you can use OutRng.Value but this is a 2D one-based array which in this case (it's one-column array) could be converted to a 1D one-based array using Application.Transpose(OutRng.Value) with its limitations. But since you have combined various cells into a range, it is expected that the range is non-contiguous (has several areas, is a multi-range), you're again at a dead end.
No matter what, it was an interesting try (IMHO).

Option Explicit

Sub FilterRange()
    
    ' Source
    Const sName As String = "Rekenblad"
    Const sCol As String = "C"
    Const sfRow As Long = 2
    ' Destination
    Const dName As String = "Plakken"
    Const dField As Long = 10
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Create a reference to the Source Range ('srg').
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    'If sws.AutoFilterMode Then sws.AutoFilterMode = False
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, sCol).End(xlUp).Row
    Dim srCount As Long: srCount = slRow - sfRow + 1
    If srCount < 1 Then Exit Sub ' no data
    Dim srg As Range: Set srg = sws.Cells(sfRow, sCol).Resize(srCount)
    
    ' Write the values from the Source Range to the Source Array ('sData').
    Dim sData As Variant
    If srCount = 1 Then ' one cell
        ReDim sData(1 To 1, 1 To 1): sData(1, 1) = srg.Value
    Else ' multiple cells (in column)
        sData = srg.Value
    End If
    
    ' Write the unique values from the Source Array to the keys
    ' of a dictionary ('dict').
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' A = a
    Dim Key As Variant
    Dim r As Long
    For r = 1 To srCount
        Key = sData(r, 1)
        If Not IsError(Key) Then ' not error value
            If Len(Key) > 0 Then ' not blank
                dict(CStr(Key)) = Empty
            'Else ' blank
            End If
        ' Else ' error value
        End If
    Next r
    If dict.Count = 0 Then Exit Sub ' only blanks and error values

    ' Filter the Destination Range ('drg') by the values in the dictionary.
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    If dws.AutoFilterMode Then dws.AutoFilterMode = False ' remove previous
    Dim drg As Range: Set drg = dws.Range("A1").CurrentRegion
    ' If the previous line doesn't work, use another way,
    ' or revert to the static:
    'Set drg = dws.Range("A1:K13")
    drg.AutoFilter dField, dict.Keys, xlFilterValues
    'dws.activate

End Sub

Multiple cells AutoFilter

1 Answers1

AutoFilter on Multiple (an Array of) Values