Search code examples
excelfilterexcel-2007vba

VBA to set autofilter in a differnt workbook to Select All for all columns


I extract data from a report into Excel, then I use this code to verify if another workbook is open (for this example it would be "Swivel - Master - January 2016.xlsm"). If the target workbook is open, then the sub will copy the valid data to the target workbook. The target workbook has the Filter turned on for columns A:AE. What I need to do is have the sub change all the filters to "Select All" so that there are no hidden rows before copying the valid data to it. I have looked this up in SO, but I could not find anything that matches what I am looking for. I also recorded a macro to see if that will work, but it did not. Not sure how to accomplish this. Thanks in advance for your help.

Sub Extract_Sort_1601_January()

Dim ANS As Long

ANS = MsgBox("Is the January 2016 Swivel Master File checked out of SharePoint and currently open on this desktop?", vbYesNo + vbQuestion + vbDefaultButton1, "Master File Open")
If ANS = vbNo Or IsWBOpen("Swivel - Master - January 2016") = False Then
    MsgBox "The required workbook is not currently open. This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure"
    Exit Sub
End If

Application.ScreenUpdating = False

    ' This line autofits the columns C, D, O, and P
    Range("C:C,D:D,O:O,P:P").Columns.AutoFit

    ' This unhides any hidden rows
    Cells.EntireRow.Hidden = False

Dim LR As Long

    For LR = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("B" & LR).Value <> "1" Then
            Rows(LR).EntireRow.Delete
        End If
    Next LR

With ActiveWorkbook.Worksheets("Extract").Sort
    With .SortFields
        .Clear
        .Add Key:=Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("D2:D2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("O2:O2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("J2:J2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("K2:K2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("L2:L2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With
    .SetRange Range("A2:AE2000")
    .Apply
End With
Cells.WrapText = False
Sheets("Extract").Range("A2").Select

    Dim LastRow As Integer, i As Integer, erow As Integer

    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To LastRow
        If Cells(i, 2) = "1" Then

            ' As opposed to selecting the cells, this will copy them directly
            Range(Cells(i, 1), Cells(i, 31)).Copy

            ' As opposed to "Activating" the workbook, and selecting the sheet, this will paste the cells directly
            With Workbooks("Swivel - Master - January 2016.xlsm").Sheets("Swivel")
                erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                .Cells(erow, 1).PasteSpecial xlPasteAll
            End With
            Application.CutCopyMode = False
        End If
    Next i

Application.ScreenUpdating = True
End Sub

Solution

  • Place this code right before your loop to copy / paste (I think).

    With Workbooks("Swivel - Master - January 2016.xlsm").Sheets("Swivel")
        erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        .Range("A1:AE" & erow).AutoFilter 'leaving arguments blank clears all filters, but leaves the drop-down arrows (filter mode still on)
    End With
    

    Or if leaving FilterMode on is not an issue (meaning if leaving it in a state where no filtering arrows appear) just do this:

    Workbooks("Swivel - Master - January 2016.xlsm").Sheets("Swivel").AutoFilterMode = False