Running a macro on mutiple files

Question

Every month I get 700 new files to clean.

I have a macro for that, but the work has always been done manually, one file at a time.

I want to run this macro on every file at once.

Sub IBO()

    Rows("1:6").Select
    Selection.Delete Shift:=xlUp
    Rows("16:18").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=6
    Rows("31:38").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=12
    Rows("46:46").Select
    Selection.Delete Shift:=xlUp
    Rows("46:47").Select
    Range("R46").Activate
    Selection.Delete Shift:=xlUp
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=15
    Rows("62:62").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=-24
    Rows("34:34").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=-9
    Rows("19:19").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=-12
    Rows("4:4").Select
    Selection.Insert Shift:=xlDown
    Range("B17:C17").Select
    ActiveWindow.SmallScroll Down:=6
    Range("B17:P32").Select
    Selection.Copy
    Range("R1").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=15
    Range("B33:T48").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AG1").Select
    ActiveSheet.Paste
    Range("A1:A3").Select
    ActiveWindow.SmallScroll Down:=33
    Range("B49:M49").Select
    ActiveWindow.SmallScroll Down:=6
    Range("B49:S64").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AZ1").Select
    ActiveSheet.Paste
    Range("BQ1").Select
End Sub

I just want to know how to add this macro on something so it would run on all files at once.

Look into the `For-Loop` structure and the `Dir()` method. Those are the 2 things you need to accomplish this. — Bernard Saucier, Mar 10 '14 at 18:46
+1 for @BernardSaucier. What the macro does is a secondary thing. Firstly you have to know how to apply any macro to multiple files. Although looping through files with `Dir` is best achieved with a `Do-Loop` loop. A `For` loop works much better using `FileSystemObject`. — Kapol, Mar 10 '14 at 18:47
@Kapol Agreed, my bad, a `While-Loop` works best here! It's safer to stay away from the `Do-Loop` since it can (if the syntax gets messed up) execute once without the condition being met. — Bernard Saucier, Mar 10 '14 at 18:54
Looping through the files will speed up the process, but once you've done that what would speed it up even more would be to [Avoid Using Select/Activate](http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select/10718179#10718179)...and eliminate all the scrolls... — ARich, Mar 10 '14 at 20:30

Math4123 · Answer 1 · 2014-03-18T16:13:16.773

Basically you would need to do 2 things:

Get a function that will loop through all the files in a folder
Change the IBO function so it would reference the cells in a different workbook

The function Example1 loops through all the files in a directory and attempts to open each one as an excel workbook, it then calls the function IBO for each of the workbooks:

Sub Example1()

    dim FOLDERPATH as string
'change this to the path of your folder
    FOLDERPATH = "D:\"
  dim objwrkbook as workbook
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer 

    ‘Create an instance of the FileSystemObject 
    Set objFSO = CreateObject(“Scripting.FileSystemObject”)
    ‘Get the folder object 
    Set objFolder = objFSO.GetFolder(FOLDERPATH)
    i = 1
    ‘loops through each file in the directory and prints their names and path 
    For Each objFile In objFolder.Files


        set objwrkbook = workbooks.add(objFile.Path)
       call IBO(objwrkbook)
        i = i + 1 
    Next objFile
End Sub

You would need to make some changes to the IBO function to be able to reference rows and cells in another workbook. In the sample below I've assumed you've got your data on sheet1 of the workbooks:

Sub IBO(byref objwrkbook as Workbook)

    objwrkbook.worksheets(1).Rows("1:6").Select
    Selection.Delete Shift:=xlUp
    objwrkbook.worksheets(1).Rows("16:18").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=6
    objwrkbook.worksheets(1).Rows("31:38").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=12
    objwrkbook.worksheets(1).Rows("46:46").Select
    Selection.Delete Shift:=xlUp
    objwrkbook.worksheets(1).Rows("46:47").Select
    objwrkbook.worksheets(1).Range("R46").Activate
    Selection.Delete Shift:=xlUp
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=15
    objwrkbook.worksheets(1).Rows("62:62").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=-24
    objwrkbook.worksheets(1).Rows("34:34").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=-9
    objwrkbook.worksheets(1).Rows("19:19").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=-12
    objwrkbook.worksheets(1).Rows("4:4").Select
    Selection.Insert Shift:=xlDown
    objwrkbook.worksheets(1).Range("B17:C17").Select
    ActiveWindow.SmallScroll Down:=6
    objwrkbook.worksheets(1).Range("B17:P32").Select
    Selection.Copy
    objwrkbook.worksheets(1).Range("R1").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=15
    objwrkbook.worksheets(1).Range("B33:T48").Select
    Application.CutCopyMode = False
    Selection.Copy
    objwrkbook.worksheets(1).Range("AG1").Select
    ActiveSheet.Paste
    objwrkbook.worksheets(1).Range("A1:A3").Select
    ActiveWindow.SmallScroll Down:=33
    objwrkbook.worksheets(1).Range("B49:M49").Select
    ActiveWindow.SmallScroll Down:=6
    objwrkbook.worksheets(1).Range("B49:S64").Select
    Application.CutCopyMode = False
    Selection.Copy
    objwrkbook.worksheets(1).Range("AZ1").Select
    ActiveSheet.Paste
    objwrkbook.worksheets(1).Range("BQ1").Select
End Sub

Also you could take a look at this article in my blog about looping through files in a folder Find and List all Files in a Directory

Thanks man, every worksheet has only one sheet that comes named after the worksheet. Also, your blog looks good, thanks. — user3402940, Mar 11 '14 at 13:59
I'm getting an "error on time of running '438' The object can't accept this method" rough tranlation from portuguese to english apparently the erro is on "IBO (objworkbook)" PS: I deleted my comment and wrote it again cuz I couldn't edit some typos — user3402940, Mar 11 '14 at 18:24
I'm actually not sure, when I try to debug, it comes back with the "IBO (objworkbook)" line yellow — user3402940, Mar 17 '14 at 19:25
hanks man, it's working now, I cleaned my own macro, so the second macro is different. Now I just have to write something to save and close the workbooks. — user3402940, Mar 18 '14 at 17:42

leftiness · Answer 2 · 2014-03-10T19:47:52.380

I appreciate the RecursiveDir function provided by Ammara Digital Solutions. It pairs well with a folder picker.

Public Function RecursiveDir(colFiles As Collection, _
                             strFolder As String, _
                             strFileSpec As String, _
                             bIncludeSubfolders As Boolean)

    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add files in strFolder matching strFileSpec to colFiles
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colFiles.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Fill colFolders with list of subdirectories of strFolder
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop

        'Call RecursiveDir for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
        Next vFolderName
    End If

End Function

Public Function TrailingSlash(strFolder As String) As String
    If Len(strFolder) > 0 Then
        If Right(strFolder, 1) = "\" Then
            TrailingSlash = strFolder
        Else
            TrailingSlash = strFolder & "\"
        End If
    End If
End Function

Sub myMacro()

    Dim strPath As String
    Dim colFiles As New Collection
    Dim varFile As Variant
    Dim wbkMyBook As Workbook

'* This is a folder picker. Left click a folder once
'* and choose select to set strPath equal to that folder.

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a folder"      '* Set the title of the folder picker window.
        .AllowMultiSelect = False       '* Do not allow multiple folders to be selected.
        .InitialFileName = "documents"  '* Set the initial location to the Windows "My Documents" folder.
        If .Show = True Then
            strPath = .SelectedItems(1) '* Set strPath equal to the selected folder.
        Else
            Exit Sub                    '* Exit the sub if you click cancel on the folder picker window.
        End If
    End With

'* Here RecursiveDir is called. It creates a collection
'* of all files (colFiles) in the path (strPath) that
'* match the filter ("*.xlsx"). The last argument (True)
'* instructs RecursiveDir to search subfolders.

    RecursiveDir colFiles, strPath, "*.xlsx", True

    For Each varFile In colFiles
        Set wbkMyBook = Workbooks.Open(varFile)

'* This is where you perform your work on each file.
'* The variable (varFile) references the current file
'* over which RecursiveDir is looping.

        Debug.Print varFile
        wbkMyBook.Sheets(1).Cells(1, 1) = "Hello."
        wbkMyBook.Close SaveChanges:=True

    Next varFile

End Sub

Not a very comprehensive solution for a beginner programmer... Could have detailed a bit more on the implementation. — Bernard Saucier, Mar 10 '14 at 19:14
@BernardSaucier When I started learning VBA three months ago, I particularly appreciated the StackOverflow answers that were less specific because I didn't have to clearly understand the first person's problem in order to apply the solution to mine. It's a personal preference. Furthermore, another answer already provided specific guidance, so I decided that I would share what I considered to be a valuable public function from an obscure source. — leftiness, Mar 10 '14 at 19:27
Valid point. Will remove my downvote whenever you make an edit to the post (won't let me untill then). — Bernard Saucier, Mar 10 '14 at 19:29
@BernardSaucier I added some comments and an example of changing each file as RecursiveDir loops. — leftiness, Mar 10 '14 at 19:53
@Bernad, thanks man, lots of info, I'll take a look and try to get it done. — user3402940, Mar 11 '14 at 13:55

Running a macro on mutiple files

2 Answers2