AutoFilter based on variable criteria

[menaafraim8]

hello friends
Since i'm new to VBA coding i'm tring to write a code that filter data based on variable cells comes from another filter in the same sheet, but keep replyig with the first value only of the selected criteria, any suggestions?

Sub FilterCriteria()
Dim vCrit As Variant
Dim wsO As Worksheet
Dim wsL As Worksheet

Dim rngOrders As Range
Set wsO = Worksheets("Orders")
Set wsL = Worksheets("Lists")
Set rngOrders = wsO.Range("$A$1").CurrentRegion

rngOrders.AutoFilter _
Field:=6, Criteria1:=Array("51", "55", "71"), _
Operator:=xlFilterValues


Dim rngCrit As Range
Set rngCrit = wsO.Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)

rngOrders.AutoFilter Field:=6 'To remove other filter to be able to look up in the whole sheet

vCrit = rngCrit.Value

rngOrders.AutoFilter _
    Field:=4, _
    Criteria1:=Application.Transpose(vCrit), _
    Operator:=xlFilterValues

End Sub

 

[p45cal]

The problem is with your code you'll only end up with the first area value(s) in vcrit because the visible cells are likely to be non-contiguous.
Try this (haven't tested for what happens when there are no values in column D nor when everything is filtered out):

Sub FilterCriteria()
Dim vCrit As Variant
Dim wsO As Worksheet
Dim wsL As Worksheet
Dim rngCrit As Range, rngOrdersdb4 As Range, cll As Range, ubnd As Long, i As Long
Dim rngOrders As Range

Set wsO = Worksheets("Orders")
Set wsL = Worksheets("Lists")
Set rngOrders = wsO.Range("$A$1").CurrentRegion
Set rngOrdersdb4 = Intersect(rngOrders, rngOrders.Offset(1)).Columns(4)    'column 4 (D) of just the databody part
rngOrders.AutoFilter Field:=6, Criteria1:=Array("51", "55", "71"), Operator:=xlFilterValues


Set rngCrit = rngOrdersdb4.SpecialCells(xlCellTypeVisible)    'just the visible cells of the databody column D.
ubnd = rngCrit.Cells.Count    'count of number of visible cells in column D.
ReDim vCrit(1 To ubnd)    'redim a variable to hold column D visible values.
i = 1
For Each cll In rngCrit.Cells    'run tyhrough the visible cells
  vCrit(i) = cll.Value    'and construct and fill the array
  i = i + 1
Next cll
rngOrders.AutoFilter Field:=6    'To remove other filter to be able to look up in the whole sheet
rngOrders.AutoFilter Field:=4, Criteria1:=vCrit, Operator:=xlFilterValues
End Sub

 

[p45cal]

Grrrr. Cross-posted and you already had a solution; I've wasted my time. Thanks a bunch.

 

[menaafraim8]

Sorry for this but i posed the two threads at the same time, thanks for your time may be it helps somebody else