Load Array extract data based on two filters and copy to new sheet

[moorecurls]

I have an array that I need to load based on two different filters and then copy data to a new sheet. I have used code from a prior post "Extract some rows to a new sorted list" but need to add an extra filter. I also am getting an error 2015 on the aRws which is not allowing the array to load on the below code:

Sub DamageArray()
Dim i As Long, j As Long, k As Long, Cols As Long, LastRow As Long, rws As Long
Dim a As Variant, b As Variant, aRws As Variant, aCols As Variant

'First actual data row in 'Sheet1'
Const FirstRow As Long = 1
'Columns of Interest in 'Sheet1', in the order I want is AY BF BG BH BI BK AU AW
Const ColsOfInterest As String = "51 58 59 60 61 63 47 49"
'Value you want to filter on
Const filterVal As String = "FL*" 'this filter needs to be on colsOfInterest 51 or AY
'Const filterVal As String = "Junk*" ''this filter needs to be on colsOfInterest 58 or BF -- this is the second that I need to filter

'Make an array of column numbers for data area
aCols = Split(ColsOfInterest)
'Number of columns in result
Cols = UBound(aCols)
With Sheets("Sheet1")
'Find last row in Index column
LastRow = .Cells(.Rows.Count, CLng(aCols(Cols))).End(xlUp).Row
'Make an array of row numbers for data area. ie 10, 11, 12, ..
aRws = Evaluate("row(" & FirstRow & ":" & LastRow & ")") '''''this is where I'm getting the 2015 error
'Read all data rows, but only the cols of interest into an array
a = Application.Index(.Columns("A:BK"), aRws, aCols)
End With
'Calculate number of data rows
rws = LastRow - FirstRow + 1
'Set up b as an array to receive results
ReDim b(1 To rws, 1 To Cols)
'Loop through rows and put ones that have correct Index value into array b
For i = 1 To rws
If a(i, 1) = filterVal Then
k = k + 1
For j = 1 To Cols
b(k, j) = a(i, j)
Next j
End If
Next i
'Put results into 'FF' sheet '''I don't need to sort I just need the array results in the same ColsOfInterest "51 58 59 60 61 63 47 49" as fields
With Sheets("SheetFF").Range("A1").Resize(k, Cols)
.Value = b
.Offset(RowsToKeep).ClearContents
End With
End Sub

Any assistance to fix the 2015 error and add a second filter that would be wonderful. Thanks so much.

 

[kevin9999]

Could you provide a sample of your data using the XL2BB add in? My gut feeling is that you're making this more complicated than it needs to be.

 

[kevin9999]

Still no response from the OP but I thought I'd post this anyway in case anyone else might find it useful. I would use an Advanced Filter to do this, because you can easily add additional filters, as well as return the filtered result with a specific columns and in whatever order you choose. I've had to use generic names for the column headers in the absence of info from the OP.

Option Explicit
Sub Advanced_Filter()
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Worksheets("Sheet1")
    Set Ws2 = Worksheets("SheetFF")
    Dim LCol As Long, LRow As Long
    LCol = Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column + 2
    LRow = Ws1.Range("AU:AU").Resize(, 17).Find("*", , xlFormulas, , 1, 2).Row
    
    Dim rngList As Range, rngCriteria As Range, rngCopyTo As Range
    
    Set rngList = Ws1.Range("AU1:BK" & LRow)
    
    Ws1.Cells(1, LCol).Resize(, 2).Value = Array("Header51", "Header58")
    Ws1.Cells(2, LCol).Resize(, 2).Value = Array("FL*", "Junk*")
    Set rngCriteria = Ws1.Cells(1, LCol).CurrentRegion
    
    Ws2.UsedRange.ClearContents
    Ws2.Cells(1).Resize(, 8).Value = Array("Header51", "Header58", "Header59", "Header60", "Header61", "Header63", "Header47", "Header49")
    Set rngCopyTo = Ws2.Range("A1").Resize(, 8)
    
    rngList.AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
    
    Ws1.Cells(1, LCol).CurrentRegion.ClearContents
End Sub

 

[moorecurls]

I resolved this by an if statement. I have a large amount of data in a report of which I only need "FL" to load into the array and then I only need "Junk" to copy to new sheet, I'm using the code below:
Sub DamageArray()
Dim vDamage() As String
Dim vRow As Long
Dim X As Long
Dim Y As Long
'multi is based on the number of arguments in the array

vRow = 63 'counter for number of columns
X = 1 ' counter for the number of rows
Do Until Len(Cells(vRow, 1)) = 0
vRow = vRow + 1
Loop
Y = vRow - 2
vRow = 2


Do Until Len(Cells(vRow, 1)) = 0
DoEvents 'to stop an endless loop
'if you have more than 1 column put the number of the columns second
're-dim the array
ReDim Preserve vDamage(1 To Y, 1 To 8) As String
'if to find the FL data only
If Trim(Cells(vRow, 51)) = "FL" Then
vDamage(X, 1) = Trim(Cells(vRow, 51))
vDamage(X, 2) = Trim(Cells(vRow, 58))
vDamage(X, 3) = Trim(Cells(vRow, 47))
vDamage(X, 4) = Trim(Cells(vRow, 49))
vDamage(X, 5) = Trim(Cells(vRow, 59))
vDamage(X, 6) = Trim(Cells(vRow, 60))
vDamage(X, 7) = Trim(Cells(vRow, 61))
vDamage(X, 8) = Trim(Cells(vRow, 63))
End If
vRow = vRow + 1
X = X + 1

Loop

'Copy data to new sheet
Damage.Activate
vRow = 15

For X = 1 To UBound(vDamage) 'UBound(vDamage) will show the highest number
'lbound(vDamage) 'to give lowest number

'if to find just the "FL", "Junk"
If Trim(vDamage(X, 2)) = "Junk" Then
Cells(vRow, 1) = vDamage(X, 1)
Cells(vRow, 2) = vDamage(X, 2)
Cells(vRow, 3) = vDamage(X, 3)
Cells(vRow, 4) = vDamage(X, 4)
Cells(vRow, 5) = vDamage(X, 5)
Cells(vRow, 6) = vDamage(X, 6)
Cells(vRow, 7) = vDamage(X, 7)
Cells(vRow, 8) = vDamage(X, 8)
End If

vRow = vRow + 1

Next 'or next x if it is nested
End Sub