4

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:

  1. Apply relevant filters to spreadsheet
  2. Export data currently visible after filter into new spreadsheet
  3. 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:

enter image description here

Upon debugging the code, I get an error message at this line:

enter image description here

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
methuselah
  • 12,766
  • 47
  • 165
  • 315
  • 2
    Isn't the instruction in the error message pretty clear? **Select a single cell within the range and try the command again.** `A2:22` is not a "single cell within the range". Words in error messages often have meaning. :-) – Ken White May 11 '14 at 17:41
  • @KenWhite - I'd like to select that range, isn't it possible? Currently only the second row is being saved to the new workbook after which I receive an error message, no more workbooks are saved... – methuselah May 11 '14 at 17:43
  • @methuselah: could you add the value of `itm` when the error appears, and show us the list you are trying to filter. Maybe you need to break the code using a *breakpoint* (F9) after the call to **TokenNotActivated** and see if there are any rows for the filter to work on in the loop, then try debugging line by line using F8. – Our Man in Bananas May 11 '14 at 18:57
  • I second the question: what is the value of itm when the error occurs? I suspect that it is empty, and that the line `LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row` could be the reason why itm is empty. – MP24 May 11 '14 at 20:06
  • @user3616377 oddly enough it isn't empty at all - the value is the next contact who needs to be filtered – methuselah May 11 '14 at 20:26
  • This is what I see in the immediate window when I do a debug.print to capture what is printed right before it appears - http://imgur.com/FyHJB6C – methuselah May 11 '14 at 20:30
  • Have you tried disabling the autofilter completely before applying the new one? – MP24 May 11 '14 at 20:34
  • Where would I put that line of code? – methuselah May 11 '14 at 20:36
  • I'd do it as first step in the FOR loop. – MP24 May 12 '14 at 05:24
  • 1
    Is your friend [@jmb](http://stackoverflow.com/q/23598142/119775)? – Jean-François Corbett May 12 '14 at 07:21

1 Answers1

2

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.

Felipe Rosa
  • 366
  • 1
  • 7