How to create multiple filter criteria using VBA

[Ingemar]

Hello,
I would like to use VBA code to create a multiple filter criteria in column "B" in "Sheet1", based on cell values, only from cells in unhidden rows, from column "A" in "Sheet2".


Cell values in column "B" in Sheet1
QTO-B1C0524
QTO-B1C0424
QTO-B1C0224
QCO-U200264
JDO-U019300
CDO-C007768


Cell values from unhidden rows in column "A" in "Sheet2".
QTO-B1C0224
JDO-U019300


By running the VBA code, column B in "Sheet1" shall look like
QTO-B1C0224
JDO-U019300

I am very greatful for any help in this matter.
Kind regards
Ingemar

 

[lrobbo314]

Let me know if this works for you...

Sub FilterEm()
Dim ws1     As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2     As Worksheet: Set ws2 = Sheets("Sheet2")
Dim r1      As Range: Set r1 = ws2.Range("A1:A" & ws1.Range("A" & Rows.Count).End(xlUp).Row)
Dim r2      As Range: Set r2 = ws1.Range("A2:A" & ws2.Range("A" & Rows.Count).End(xlUp).Row)


r1.AutoFilter Field:=1, Criteria1:=Array(Application.Transpose(r2)), Operator:=xlFilterValues
End Sub

 

[Ingemar]

Hello Irobbo314,
Thanks for trying help me but the code does not filter the table in Sheet1. Did you test the code in an Excel file on your computer?
Kind regards
Ingemar

 

[lrobbo314]

I tested, but I missed that one of your columns was in column B. The code below fixed that. Also, This code assumes that both Columns, B from sheet2 and A from sheet1, have header rows. If you don't actually have header rows, the code will need to be adjusted.

Sub FilterEm()
Dim ws1     As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2     As Worksheet: Set ws2 = Sheets("Sheet2")
Dim r1      As Range: Set r1 = ws1.Range("B1:B" & ws1.Range("B" & Rows.Count).End(xlUp).Row)
Dim r2      As Range: Set r2 = ws2.Range("A2:A" & ws2.Range("A" & Rows.Count).End(xlUp).Row)




r1.AutoFilter Field:=1, Criteria1:=Array(Application.Transpose(r2)), Operator:=xlFilterValues
End Sub

 

[Fluff]

How about

Sub FilterData()
   Dim Cl As Range, Rng As Range
   Dim i As Long
   
   With Sheets("Sheet2")
      Set Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlVisible)
      ReDim ary(Rng.Count)
      For Each Cl In Rng
         ary(i) = Cl.Value
         i = i + 1
      Next Cl
   End With
   With Sheets("Sheet1")
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("B:B").AutoFilter 1, ary, xlFilterValues
   End With
End Sub

@lrobbo314
Your code wont take into account the hidden cells in Sheet2.

 

[Ingemar]

Hello Fluff,
Thank you for helping me. Your code works better. However, I would like to keep the filter buttons in "Sheet1" and use the data from "Sheet2" as filter criteria like:
.Range("A1:AD1").AutoFilter Field:2, Criteria1:=... or similar.

Kind regards
Ingemar

 

[Fluff]

In that case replace

With Sheets("Sheet1")
   If .AutoFilterMode Then .AutoFilterMode = False
   .Range("B:B").AutoFilter 1, Ary, xlFilterValues
End With

with

Sheets("Sheet1").Range("A1:AD1").AutoFilter 2, Ary, xlFilterValues

 

[Ingemar]

Hello Fluff,
the last code does exactly what i want to do. I take this oportunity to T H A N K Y O U for your help.

Kind regards
Ingemar

 

[Fluff]

Glad we could help & thanks for the feedback