Using Autofilter with a dynamic range - excel

Question

Still learning the ropes so bear with! I have a monthly data dump that will be copied into the workbook, it is always in the same format. I'm trying to write a macro that filters the data in a preset column using a list of names from another sheet within the workbook. Ideally I want to be able to add or remove names from the list. Once it has filtered I'd like it to copy all those visible cells and paste them into a new sheet.
I've started with using the autofilter and then a counting array, but I am getting an error AND it's not filtering. In that the filter is applied to the sheet, but it doesn't seem to be able to look for the actual names, and just returns blanks.
It does seem to count the right number of names in my dynamic list... so I'll take that.
So example data:
Worksheet: Names
Worksheet: Books
Code ideally takes the list of names from the Person column in "Names", looks through the Name column "Books", finds each match and then copies and dumps the entire row to a new sheet.
Here is my best attempt at writing something.
Sub FilterName()
Dim i As Long
Dim lastrow As Long
Dim arrSummary() As Variant
With ThisWorkbook.Sheets("Names")
lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
ReDim arrSummary(1 To lastrow)
For i = 1 To lastrow
arrSummary(i) = .Cells(i, 1)
Next
End With
For i = LBound(arrSummary) To UBound(arrSummary)
With ThisWorkbook.Sheets("Books")
.Range("F:F").AutoFilter Field:=1, Criteria1:=arrSummary(i), Operator:=xlFilterValues
.ThisWorkbook.Sheets("Books").Range("A1:AA100000").SpecialCells(xlCellTypeVisible).Copy
'Getting error 438 here
.ThisWorkbook.Sheets("Loans").Paste
End With
Next i
End Sub
I did contemplate advanced filter but couldn't make that work even outside of VBA, and then didn't want to do the find route as felt it was clunky...Willing to explore these options though.
Cheers :)

Answer 1

Filter Names
It will write the values from column B (cCol) of the criteria worksheet (cws) to a 2D one-based one-column array (cData). Then it will loop through the values in the array and filter the 6th column (scCol) of the source worksheet (sws) by each of the array's values and copy the source range's (A:AA) rows that contain the matching cells to the first available row of the destination worksheet (dws) starting in column A (dfCol).
Option Explicit
Sub FilterNames()
' Criteria
Const cName As String = "Names"
Const cCol As String = "B"
Const cfRow As Long = 2
' Source
Const sName As String = "Books"
Const sCols As String = "A:AA"
Const scCol As Long = 6 ' also used for AutoFilter's Field parameter
Const sfRow As Long = 1
' Destination
Const dName As String = "Loans"
Const dfCol As String = "A"
Const dfRow As Long = 2
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook
' Criteria
Dim cws As Worksheet: Set cws = wb.Worksheets(cName)
Dim clRow As Long: clRow = cws.Cells(cws.Rows.Count, cCol).End(xlUp).Row
If clRow < cfRow Then Exit Sub
Dim crCount As Long: crCount = clRow - cfRow + 1
Dim crg As Range: Set crg = cws.Cells(cfRow, cCol).Resize(crCount)
Dim cData As Variant
If crCount = 1 Then
ReDim cData(1 To 1, 1 To 1): cData(1, 1) = crg.Value
Else
cData = crg.Value
End If
' Source
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim srg As Range: Set srg = sws.UsedRange.Columns(sCols)
Dim sdrg As Range: Set sdrg = srg.Resize(srg.Rows.Count - 1).Offset(1)
Dim sdcrg As Range: Set sdcrg = sdrg.Columns(scCol)
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, dfCol).End(xlUp).Row
Dim dCell As Range
If dlRow < dfRow Then
Set dCell = dws.Cells(dfRow, dfCol)
Else
Set dCell = dws.Cells(dlRow, dfCol).Offset(1)
End If
Application.ScreenUpdating = False
Dim drCount As Long
Dim r As Long
For r = 1 To UBound(cData, 1)
sws.AutoFilterMode = False
srg.AutoFilter scCol, CStr(cData(r, 1)), xlFilterValues
drCount = Application.Subtotal(103, sdcrg)
Debug.Print drCount, cData(r, 1)
If drCount > 0 Then
sdrg.SpecialCells(xlCellTypeVisible).Copy
dCell.PasteSpecial xlPasteValues
Set dCell = dCell.Offset(drCount)
End If
Next r
Application.CutCopyMode = False
sws.AutoFilterMode = False
If dws Is ActiveSheet Then
dws.Range("A1").Activate
Else
Dim ash As Worksheet: Set ash = ActiveSheet
dws.Activate
dws.Range("A1").Activate
ash.Activate
End If
'wb.Save
Application.ScreenUpdating = True
MsgBox "Data transferred.", vbInformation, "Filter Names"
End Sub

Answer 2

You can achieve your goal without VBA but with the new FILTER-function if you have Excel 365.
In my example I created two tables (Insert > Table) named them tblPeople and tblBooks.
That way the formula is very easy to read:
Regarding your code: When you have a lot of data this process will be very slow.
In general you achieve a better performance when reading the data into an array (like you already did with the peoples sheet), do the filtering in the array and then write the array back to the sheet (you will find a lot of examples here on SO.
By the way: you can read a range to an array like this:
arrSummary = rg.value where rg is the range you want to read.