Select specific columns from worksheet to save

Question

I am working with a friend on a spreadsheet which we are applying multiple filters to.

The first filter runs across column M and U:

Sub TokenNotActivated()

'Col H = Laptop - Main
'Col H = Desktop
'Col M = Yes
'Col U = provisioned
ThisWorkbook.Sheets(2).Activate
ActiveSheet.Range("A2:Z2").Select
Selection.AutoFilter Field:=8, Criteria1:="Desktop", Operator:=xlOr, Criteria1:="Laptop - Main"
Selection.AutoFilter Field:=13, Criteria1:="Yes"
Selection.AutoFilter Field:=21, Criteria1:="provisioned", Operator:=xlFilterValues

End Sub

The second filter acts against column F, filtering each unique value found in there

e.g.

would return as filters for John, Sarah, Frank. Furthermore if there are no rows to be found for either one of them after the first set of filters is run, then it is skipped. The code responsible for this is below:

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 rows 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

' Create workbooks - Token Not activated
Call TokenNotActivated
For Each itm In Col
    ActiveSheet.Range("A2:Z2").Select
    Selection.AutoFilter Field:=6, Criteria1:=itm
    Call TokenNotActivatedProcess
Next

ActiveSheet.AutoFilter.ShowAllData

End Sub

The third thing I want to do is create a new spreadsheet saved in C:\Working\ for each of the results shown after the second filter is applied. See once the second filter is applied, the spreadsheet "resets" in a way and to allow for fresh new filtering process (see code above). I've been playing around with to ensure I get the correct data pulled. By printing to the Immediate window and it is all correct. The code that does this is below:

' Run the process to get the workbook 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
End Function

My question now is - how do I select columns A,B,C,D,E,Z from row 3 to the last row (after both filters are applied) and then save it to an external Excel spreadsheet with each iteration of the filter process? I'm only interested in outputs that produce a value in the Immediate window (i.e. where there are visible cells to be seen). Ideally I want to have them in the following format:

TokenNotActivated - Sarah - 110514.xlsx
TokenNotActivated - John - 110514.xlsx
TokenNotActivated - Jack - 110514.xlsx

Answer 1

Let's modify your function a little bit and have it return a value:

Function TokenNotActivatedProcess() As Boolean
    Dim r As Range, n As Long, itm, FirstRow As Long, ret as Boolean
    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
        ret = True
    End If
    TokenNotActivatedProcess = ret
End Function

Then, you can change your For each itm in Col loop. Instead of calling the function, just evaluate it as part of boolean logic, since it returns a boolean, you can do this.

Dim ws As Worksheet
Set ws = ActiveSheet

For Each itm In Col
    ws.Range("A2:Z2").AutoFilter Field:=6, Criteria1:=itm
    If TokenNotActivatedProcess Then

        'Dim wbNew as Workbook
        'Set wbNew = Workbooks.Add
        '
        '### Add code here which will create a new workbook
        '    and copy the data to the new workbook.
        '    This would probably be another subroutine or function.
        '
        'wbNew.SaveAs "C:\new file.xlsx"
        'wbNew.Close

    End If
Next

This will fix it eventually, but you are relying on Activate and Selection methods, which becomes very problematic when you are working with multiple workbooks, as discussed here:

How to avoid using Select in Excel VBA macros

I modified the loop above to avoid this but there may be other places you need to fix.

If you have trouble modifying your code to avoid using Activate/Select methods, or if you have problems adding new workbooks to copy the data, just update your question with your current code. It should not be very difficult to do this.