Automatic spreadsheet generation in Excel VBA - vba

Question

My friend and I currently have a master spreadsheet that I need to be broken out into smaller spreadsheets regularly. This used to be a manual process, but I'd like to automate it. I created a three step solution in VBA which would help me accomplish this that did the following:
Apply relevant filters to spreadsheet
Export data currently visible after filter into new spreadsheet
Save spreadsheet and go back to 1 (different criteria)
Unfortunately I am having a hard time implementing it. Whenever I try to generate the spreadsheet, my document hangs, starts performs several calculations and then gives this me this error message:
Upon debugging the code, I get an error message at this line:
One Excel workbook is left open and only one row is visible (the second row pulled from the Master which contains header information) and nothing else.
What exactly is going on here?
This is my code so far:
The heart of it all
' This bit of code get's all the primary contacts in column F, it does
' this by identifying all the unique values in column F (from F3 onwards)
Sub GetPrimaryContacts()
Dim Col As New Collection
Dim itm
Dim i As Long
Dim CellVell As Variant
'Get last row value
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
'Loop between all column F to get unique values
For i = 3 To LastRow
CellVal = Sheets("Master").Range("F" & i).Value
On Error Resume Next
Col.Add CellVal, Chr(34) & CellVal & Chr(34)
On Error GoTo 0
Next i
' Once we have the unique values, apply the TOKEN NOT ACTIVATED FILTER
Call TokenNotActivated
For Each itm In Col
ActiveSheet.Range("A2:Z2").Select
Selection.AutoFilter Field:=6, Criteria1:=itm
' This is where the magic happens... creating the individual workbooks
Call TokenNotActivatedProcess
Next
ActiveSheet.AutoFilter.ShowAllData
End Sub
The "token not activated" filter
Sub TokenNotActivated()
'Col M = Yes
'Col U = provisioned
ThisWorkbook.Sheets(2).Activate
ActiveSheet.Range("A2:Z2").Select
Selection.AutoFilter Field:=13, Criteria1:="Yes"
Selection.AutoFilter Field:=21, Criteria1:="provisioned", Operator:=xlFilterValues
End Sub
Running the process to get the workbooks saved
Function TokenNotActivatedProcess()
Dim r As Range, n As Long, itm, FirstRow As Long
n = Cells(Rows.Count, 1).End(xlUp).Row
Set r = Range("A1:A" & n).Cells.SpecialCells(xlCellTypeVisible)
FirstRow = ActiveSheet.Range("F2").End(xlDown).Row
itm = ActiveSheet.Range("F" & FirstRow).Value
If r.Count - 2 > 0 Then Debug.Print itm & " - " & r.Count - 2
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="C:\Working\Testing\TokenNotActivated - " & itm + ".xls", FileFormat:=52, CreateBackup:=False
End Function

Answer 1

This error is caused by trying to filter an empty range. After analysing your code, my guess is that you are missing a worksheet activation here, since repeating the line ActiveSheet.Range("A2:Z2").Select after calling the function TokenNotActivated does not make sense and maybe your code is trying to filter some empty range/worksheet.