Adding variable string to array and then filtering on that.

[RockandGrohl]

Hello.

I'd like to add an indeterminate amount of strings to an array, and then use that array as filter criteria on another sheet.

In order to find what to add to the array, I would be looking at the left(6) of column 1, and then the string on column 29 needs to be added.

Here's an example:

Column 1	Column 29	Added?
DONKEY	A1	Y
DONKEY-F	A3	Y
DONKEY-F	A4	Y
DONKEY-F	A6	Y
BADGER	A5	N
BADGER-F	A2	N

So if my current row was on DONKEY, I would see that left(6) would result in finding A1, A3, A4 and A6. So I want to add them to an array, then autofilter a range ("A1:BD" & LastrowDF) on field 56 with the CriteriaArray("A1", "A3" etc)

Is this possible? Can you add things to an array piece by piece? Cheers.

 

[RockandGrohl]

This is where I'm at. Unfortunately, once the RegAr(q) cell value is added, and then q=q+1 happens, I get a "Subscript out of range" error.

        tref = Left(Cells(ActiveCell.Row, "A").Value, 6)
        
        Dim RegAr() As Variant
        Dim cell As Range, rng As Range
        Dim q As Long
        Set rng = Range("AC3:AC" & LastrowPPL)
        
        On Error Resume Next
        ActiveSheet.ShowAllData
        On Error GoTo 0
        
        Range("A2:AG" & LastrowPPL).AutoFilter field:=1, Criteria1:=tref & "*"
        For Each cell In rng.SpecialCells(xlCellTypeVisible)
            ReDim Preserve RegAr(q)
            RegAr(q) = cell.Value
            q = q + 1
        Next cell

Any ideas? Thanks.

 

[Fluff]

How about

Sub rockandGrohl()
   Dim Rws As Variant, Ary As Variant
   
   With Range("A2:AC" & Range("A" & Rows.Count).End(xlUp).Row)
      Rws = Filter(Evaluate(Replace("transpose(if(left(@,6)=""Donkey"",row(@)-min(row(@))+1,false))", "@", .Columns(1).Address)), False, False)
      Ary = Application.Index(.Value2, Rws, 29)
   End With
End Sub

 

[RockandGrohl]

How about

Sub rockandGrohl()
   Dim Rws As Variant, Ary As Variant
  
   With Range("A2:AC" & Range("A" & Rows.Count).End(xlUp).Row)
      Rws = Filter(Evaluate(Replace("transpose(if(left(@,6)=""Donkey"",row(@)-min(row(@))+1,false))", "@", .Columns(1).Address)), False, False)
      Ary = Application.Index(.Value2, Rws, 29)
   End With
End Sub

Hi Fluff,

I get Type Mismatch when I do this:

            With Range("A2:AC" & Range("A" & Rows.Count).End(xlUp).Row)
               Rws = Filter(Evaluate(Replace("transpose(if(left(@,6)=""N05C18"",row(@)-min(row(@))+1,false))", "@", .Columns(1).Address)), False, False)
               Ary = Application.Index(.Value2, Rws, 29)
            End With

or this:

            With Range("A2:AC" & Range("A" & Rows.Count).End(xlUp).Row)
               Rws = Filter(Evaluate(Replace("transpose(if(left(@,6)=" & tref & ",row(@)-min(row(@))+1,false))", "@", .Columns(1).Address)), False, False)
               Ary = Application.Index(.Value2, Rws, 29)
            End With

tref is the value of left-6 of the cell in column 1. Thanks.

 

[Fluff]

It needs to be

      Rws = Filter(Evaluate(Replace("transpose(if(left(@,6)=""" & tref & """,row(@)-min(row(@))+1,false))", "@", .Columns(1).Address)), False, False)

 

[RockandGrohl]

It needs to be

      Rws = Filter(Evaluate(Replace("transpose(if(left(@,6)=""" & tref & """,row(@)-min(row(@))+1,false))", "@", .Columns(1).Address)), False, False)

Hi Fluff, so when I do this:

            Dim ArRows As Variant, Ary As Variant
   
            With Range("A3:AC" & Range("A" & Rows.Count).End(xlUp).Row)
               ArRows = Filter(Evaluate(Replace("transpose(if(left(@,6)=""" & tref & """,row(@)-min(row(@))+1,false))", "@", .Columns(1).Address)), False, False)
               Ary = Application.Index(.Value2, ArRows, 29)
            End With

(Rws is already declared in another point in my code)

It appears that only the string on the current line is added to the array. When I switch to the other sheet to filter:

REQ = Cells(ActiveCell.Row, "AB").Value
        
        op.Activate
        On Error Resume Next
        ActiveSheet.ShowAllData
        On Error GoTo 0
        LastrowDF = Cells(Rows.Count, "A").End(xlUp).Row
        Range("BD1").Value = "TourRef"
        
        Range("A1:BD" & LastrowDF).AutoFilter field:=18, Criteria1:=Array(Ary)
        Range("A1:BD" & LastrowDF).AutoFilter field:=56, Criteria1:=""

It only filters down to "A4", and not the expected 6 different strings (A1 through to A6)

Thanks.

 

[Fluff]

Try

Range("A1:BD" & LastrowDF).AutoFilter 18, Ary, xlFilterValues

 

[RockandGrohl]

Fantastic. You come in swinging with another magic Evaluate code and it solves a problem in just a couple lines of code, again. How do you do it?!

 

[Fluff]

You're welcome & thanks for the feedback.

How do you do it?!

It's just what I've learnt from other members on here.

 

[RockandGrohl]

PS, do you know why I was getting a Subscript out of range error on post number 2? It seems like a handy bit of code that I'd like to implement in other areas. Thanks.