VBA code - database Autofilter with cells in orther Sheet

user_15136039 0
Viewed 90

i need your help on the VBA code : i would like to make a filter on a database according cells in another sheets my code is working but make a filter only in one cell. How to filter if the code found all cells from the Range

Please see my code :

Sub test()


Sheets("Dashboard").Select
Dim arr As Variant

'arr = Sheets("Dashboard").Range("B4:B11")
With Sheets("Database")

With .Range("A1:Z" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            .AutoFilter 'Turn off any previous filtering
            .AutoFilter Field:=1, Criteria1:=Sheets("Dashboard").Range("B4:B11")
        End With
End With
End Sub

Thanks for your help

vba excel
3 Answers

Please, test the next way:

Sub filterByRange()
 Dim arr, rng As Range
 
 Set rng = Sheets("Dashboard").Range("B4:B11")
 rng.TextToColumns Destination:=rng.cells(1), FieldInfo:=Array(1, 2)
 arr = rng.Value     
 arr = Application.Transpose(Application.Index(arr, 0, 1)) '1D array

 With Sheets("Database")
   With .Range("A1:Z" & .cells(.Rows.count, "A").End(xlUp).row)
            .AutoFilter
            .AutoFilter field:=1, Criteria1:=arr, Operator:=xlFilterValues
   End With
 End With
End Sub
user_22333080

Less is more. I adapted the code provided by @FaneDuru utilising some shortcuts. Please note that when it comes to AutoFilter, there’s (usually) no need to specify the complete range you want to filter – it filters all rows meeting the criteria so last column is irrelevant. As long as the data is contiguous, there’s no need to specify the last row either.

Provided for interest only.

Sub testFilter()
Dim Arr

Arr = Sheets("Dashboard").Range("B4:B11").Value
Arr = Application.Transpose(Application.Index(Arr, 0, 1))

With Sheets("Database").Range("A1").CurrentRegion
    .AutoFilter 1, Array(Arr), 7
End With

End Sub
Admin1

Try this:

Sub SubRangeBasedAutofilter()
    
    'Declarations.
    Dim RngCell As Range
    Dim RngCriteria As Range
    Dim StrCriteria() As String
    Dim DblCriteriaCount As Double
    
    'Selecting Dashboard sheet.
    Sheets("Dashboard").Select '<-IS THIS NECESSARY?
    
    'Setting RngCriteria.
    Set RngCriteria = Sheets("Dashboard").Range("B4:B11")
    
    'Redeclaring StrCriteria() with proper size.
    ReDim StrCriteria(Excel.WorksheetFunction.Max(Excel.WorksheetFunction.CountA(RngCriteria) - 1, 1))
    
    'Covering each in RngCriteria.
    For Each RngCell In RngCriteria
        'Checking if RngCell is not empty.
        If RngCell.Value <> "" Then
            'Storing the criteria.
            StrCriteria(DblCriteriaCount) = "=" & RngCell.Value
            DblCriteriaCount = DblCriteriaCount + 1
        End If
    Next
    
    'Focusing Database sheet.
    With Sheets("Database")
        'Turning off any eventual autofilter.
        .AutoFilterMode = False
            'Setting a new autofilter.
            With .Range("A1:Z" & .Cells(.Rows.Count, "A").End(xlUp).Row)
                .AutoFilter Field:=1, Criteria1:=StrCriteria, Operator:=xlFilterValues
            End With
    End With
    
End Sub
user_87802580
Related