AutoFilter applied to all files in a directory

Question

Objective: Loop through all files in a folder, and for each file, apply a filter based on Column 1 = "A". Then save over the ActiveWorkbook with the filter applied.

The below times out at ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="A" and i'm not sure why

Sub FilterApply()

Dim folderName As String
Dim filelocation As String

Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim FSOFile As Object
Dim TargetWB As Workbook


'Set the file name to a variable
folderName = "X:\"
filelocation = "X:\"


'Set all the references to the FSO Library
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(folderName)
Set FSOFile = FSOFolder.Files


'Apply Autofilter to all sheets in FSOFolder

For Each FSOFile In FSOFile
    If Not ActiveSheet.AutoFilterMode Then
        ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="A"
        ActiveWorkbook.Save
    End If
    Next

Answer 1

Apply Autofilter in Multiple Files

• You forgot to open the file: Workbooks.Open.

• This page contains a great example of how to handle the File System Object when handling files.

• Using the second code, you can monitor what is happening
  in the Immediate window CRTL+G.

• If all the workbooks have worksheets with the same name, you should properly qualify them, e.g. Set ws = wb.Worksheets("Sheet1"). If they only have one worksheet than you don't have to bother. But if they have multiple worksheets you might get unexpected results, if you cannot be sure which worksheet was active before the last save.

The Code

Option Explicit

Sub FilterApply()

    Dim folderName As String
    
    Dim FSOLibrary As Object
    Dim FSOFolder As Object
    Dim FSOFiles As Object
    Dim FSOFile As Object
    
    'Set the file name to a variable
    folderName = "F:\Test\02.07.20"
    
    'Set all the references to the FSO Library
    Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
    Set FSOFolder = FSOLibrary.GetFolder(folderName)
    Set FSOFiles = FSOFolder.Files
    
    'Apply Autofilter to all sheets in FSOFolder
    Dim wb As Workbook
    Dim ws As Worksheet
    For Each FSOFile In FSOFiles
        Set wb = Workbooks.Open(FSOFile.Path)
        Set ws = wb.ActiveSheet ' wb.worksheets("Sheet1") is safer.
        If Not ws.AutoFilterMode Then
            On Error Resume Next
            ws.Range("A1").AutoFilter Field:=1, Criteria1:="A"
            If Err.Number = 0 Then
                wb.Close SaveChanges:=True
            Else
                wb.Close SaveChanges:=False
            End If
            On Error GoTo 0
        Else
            wb.Close SaveChanges:=False
        End If
    Next

End Sub


Sub FilterApplyErr()

    Dim folderName As String
    
    Dim FSOLibrary As Object
    Dim FSOFolder As Object
    Dim FSOFiles As Object
    Dim FSOFile As Object
    
    'Set the file name to a variable
    folderName = "F:\Test\02.07.20"
    
    'Set all the references to the FSO Library
    Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
    Set FSOFolder = FSOLibrary.GetFolder(folderName)
    Set FSOFiles = FSOFolder.Files
    
    'Apply Autofilter to all sheets in FSOFolder
    Dim wb As Workbook
    Dim ws As Worksheet
    For Each FSOFile In FSOFiles
        Set wb = Workbooks.Open(FSOFile.Path)
        Set ws = wb.ActiveSheet ' wb.worksheets("Sheet1") is safer.
        If Not ws.AutoFilterMode Then
            On Error Resume Next
            ws.Range("A1").AutoFilter Field:=1, Criteria1:="A"
            Select Case Err.Number
                Case 0
                    Debug.Print "The data in worksheet '" & ws.Name _
                              & "' of workbook '" & wb.Name _
                              & "' was filtered now."
                    wb.Close SaveChanges:=True
                Case 1004
                    If Err.Description = "AutoFilter method of Range class " _
                                       & "failed" Then
                        Debug.Print "Worksheet '" & ws.Name & "' in workbook " _
                                  & "'" & wb.Name & "' has no data in cell " _
                                  & "'A1'."
                        wb.Close SaveChanges:=False
                    Else
                        Debug.Print "Run-time error '" & Err.Number _
                                  & "': " & Err.Description
                        wb.Close SaveChanges:=False
                End If
            Case Else
                Debug.Print "Run-time error '" & Err.Number _
                          & "': " & Err.Description
                wb.Close SaveChanges:=False
            End Select
            On Error GoTo 0
        Else
            Debug.Print "The data in worksheet '" & ws.Name _
                      & "' of workbook '" & wb.Name _
                      & "' had already been filtered."
            wb.Close SaveChanges:=False
        End If
    Next

End Sub