How do I run the same macro on multiple Excel files?

Question

This macro puts comma separated values into different cells, it is working correctly when I use it in one Excel file:

Sub toColumns()
'
' toColumns Macro
' Changes csv to columns
'
' Keyboard Shortcut: Ctrl+a
'
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
End Sub

I am trying this to do it for all files in a folder. So adapted code is:

Sub ProcessFiles()
    Dim Filename, Pathname As String
    Dim wb As Workbook

    Pathname = "H:\Macro\positions"
    Filename = Dir(Pathname & "*.xls")
    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        DoWork wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop
End Sub

Sub DoWork(wb As Workbook)
    With wb
        'Do your work here
        Columns("A:A").Select
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
    End With
End Sub

But nothing happens when I run it. This is my first approach to VBA and Excel macros.

What am I missing?

Possible duplicate of [Run same excel macro on multiple excel files](https://stackoverflow.com/q/14766238/608639) — jww, Oct 17 '18 at 05:25

score 4 · Accepted Answer · answered Jun 15 '17 at 09:24

4

Three things

Change Pathname = "H:\Macro\positions" to Pathname = "H:\Macro\positions\"
Add Doevents after the line wb.Close SaveChanges:=True to give time to excel to save the file else excel may crash.
Change the DoWork(wb As Workbook) to this. You have to fully qualify your objects else it may work with the wrong worksheet.

Code

Sub DoWork(wb As Workbook)
    With wb.Sheets(1) '<~~ Or change this to the relevant sheet number
        .Columns(1).TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
    End With
End Sub

answered Jun 15 '17 at 09:24

Siddharth Rout

147,039
17
206
250

Thank you for your help, however, even with this three steps, when I click run it is instantaneous, and nothing happens. I was expecting a few minutes to process more than 10000 files. – Daniel Viaño Jun 15 '17 at 09:32
1

Are you sure it is `.xls` and not `.xlsx` or `.xlsm` files? – Siddharth Rout Jun 15 '17 at 09:33
1

If it is a mix of `.xls/.xlsx/.xlsm` then change the line to `Dir(Pathname & "*.xls*")` – Siddharth Rout Jun 15 '17 at 09:35
It was that! Now it is working. If I have one of the files opened I see how it is correctly processed but later goes back to original. Is not SaveChanges:=True and DoEvents written to solve that? – Daniel Viaño Jun 15 '17 at 09:40
1

Did you use my `Sub DoWork(wb As Workbook)` as shown above? – Siddharth Rout Jun 15 '17 at 09:42
Yes, copy-paste – Daniel Viaño Jun 15 '17 at 09:43
1

Let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/146739/discussion-between-siddharth-rout-and-daniel-viano). – Siddharth Rout Jun 15 '17 at 09:44

score 0 · Answer 2 · answered Jun 16 '17 at 21:20

If I understand you correctly, you want to modify 10,000 excel files. Is that right? try it this way.

Sub Example()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String, Fnum As Long
    Dim mybook As Workbook
    Dim CalcMode As Long
    Dim sh As Worksheet
    Dim ErrorYes As Boolean

    'Fill in the path\folder where the files are
    MyPath = "C:\Users\Ron\test"

    'Add a slash at the end if the user forget it
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    'If there are no Excel files in the folder exit the sub
    FilesInPath = Dir(MyPath & "*.xl*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    'Fill the array(myFiles)with the list of Excel files in the folder
    Fnum = 0
    Do While FilesInPath <> ""
        Fnum = Fnum + 1
        ReDim Preserve MyFiles(1 To Fnum)
        MyFiles(Fnum) = FilesInPath
        FilesInPath = Dir()
    Loop

    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Loop through all files in the array(myFiles)
    If Fnum > 0 Then
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
            On Error GoTo 0

            If Not mybook Is Nothing Then


                'Change cell value(s) in one worksheet in mybook
                On Error Resume Next
                ' PUT YOUR CODE RIGHT HERE . . .


                If Err.Number > 0 Then
                    ErrorYes = True
                    Err.Clear
                    'Close mybook without saving
                    mybook.Close savechanges:=False
                Else
                    'Save and close mybook
                    mybook.Close savechanges:=True
                End If
                On Error GoTo 0
            Else
                'Not possible to open the workbook
                ErrorYes = True
            End If

        Next Fnum
    End If

    If ErrorYes = True Then
        MsgBox "There are problems in one or more files, possible problem:" _
             & vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
    End If

    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
End Sub

https://www.rondebruin.nl/win/s3/win010.htm

How do I run the same macro on multiple Excel files?

2 Answers2