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