Run macro on all xls files that contain certain word

[wirescool]

Hello! I'd like to run a macro called "NoFeeAudit" on all xls files in a certain folder and subfolders that contain the word "Current" in the file name.

I'm fairly new to VBA, so I poked around online, and arrived at this:

Sub runMe()

    Dim objFSO As Object
        Dim objFolder As Object
        Dim objFile As Object
        Dim MyPath As String
        Dim wb As Workbook


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With


    MyPath = "...\Clients"


    Set objFSO = CreateObject("Scripting.FileSystemObject")


    'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder(MyPath)


    'Loop through the Files
    For Each objFile In objFolder.Files
        If InStr(objFile.Name, "~") = 0 _
            And InStr(objFile.Name, "Current *") <> 0 And InStr(objFile.Name, ".xls") <> 0 Then
            Set wb = Workbooks.Open(objFile, 3)
            Application.Run "'" & wb.Name & "'!NoFeeAudit"
            wb.Close SaveChanges:=True
        End If
    Next


    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With


End Sub

When I run this, it looks like I'm getting stuck in an infinite loop. No errors/breaks, but no results, either.

Where did I go wrong?

Thanks in advance!

 

[wirescool]

That's exactly the reason why the users are trying to extract this information - they know that the clients' folders and files are full of spreadsheet sins that go years back, and we're migrating to a web app system to have this stored in a clean, secure way.

Is stopping the search for NFs beyond the "Total Investment Assets" line asking too much of this one macro? It's already working around so many problems, but I can see there being push-back from the team about getting them to review and remove old line items below-the-line in all client sheets.

 

[mumps]

See if this works for you:

Sub DoFolder(Folder)
    Application.ScreenUpdating = False
    Dim TIARow As Long
    Dim wsSheet As Worksheet
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    Dim File
    Application.DisplayAlerts = False
    For Each File In Folder.Files
        If File.Name Like "*Current*.xls" Then
            Set srcWB = Workbooks.Open(Filename:=File, UpdateLinks:=3)
            With ActiveWorkbook
                On Error Resume Next
                Set wsSheet = .Sheets("P3,4 Detail")
                On Error GoTo 0
                If Not wsSheet Is Nothing Then
                    lastrow = .Sheets("P3,4 Detail").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    TIARow = Range("C:C").Find("Total Investment Assets").Row
                    If WorksheetFunction.CountIf(.Sheets("P3,4 Detail").Range("I2:I" & TIARow - 1), "NF") > 0 Then
                        .Sheets("P3,4 Detail").Range("A3:A" & lastrow) = srcWB.Name
                        .Sheets("P3,4 Detail").Cells.MergeCells = False
                        .Sheets("P3,4 Detail").Range("I1:I" & TIARow - 1).AutoFilter Field:=1, Criteria1:="NF"
                        .Sheets("P3,4 Detail").Range("I3:I" & TIARow - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
                        ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    End If
                End If
                ActiveWorkbook.Close savechanges:=False
            End With
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[wirescool]

That failed with Object variable or With block variable not set (Error 91) on this row:

TIARow = Range("C:C").Find("Total  Investment  Assets").Row

Do we need to set merge cells to false before this line?

 

[mumps]

Replace that row with:

TIARow = .Sheets("P3,4 Detail").Range("C:C").Find("Total Investment Assets").Row

 

[wirescool]

That seems to fail with the same error. Not sure if this would have any impact, but I've been adjusting to show two spaces in between words, as that's how it displays on the client sheets:

TIARow = .Sheets("P3,4 Detail").Range("C:C").Find("Total  Investment  Assets").Row

 

[mumps]

It's hard for me to tell without seeing the client sheet. Perhaps you could upload a copy of the file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[wirescool]

I sent you a link in your PMs. Let me know if you have any trouble viewing it.

 

[mumps]

In row 56 where "Total Investment Assets" is found, C56:N56 is merged. Unmerged the cells and try again.