none
How to run one macro for multiple excel files ? RRS feed

  • Question

  • Hi

    Suppose I have about 100+ Excel 2010 files and I want to run one special macro for all of them at the same time. Does Microsoft Excel 2010 have an option to execute this or I must write command in Vba editor. if so, how !? can you help me ...

    Many Thanks

    Alireza

    Wednesday, January 21, 2015 6:06 PM

Answers

  • You have to write code for it. Let's say that you have a macro MyMacro that acts on the currently active workbook, and that you have placed all workbooks that you want to process in a single folder, with no other workbooks.

    Create the following macro in the same workbook that contains MyMacro:

    Sub ProcessFolder()
        Dim strPath As String
        Dim strFile As String
        Dim wbk As Workbook
        ' Let user select a folder
        With Application.FileDialog(4) ' msoFileDialogFolderPicker
            If .Show Then
                strPath = .SelectedItems(1)
                If Right(strPath, 1) <> "\" Then
                    strPath = strPath & "\"
                End If
            Else
                MsgBox "No folder specified. Exiting...", vbInformation
                Exit Sub
            End If
        End With
        ' Loop through the workbooks in the folder
        strFile = Dir(strPath & "*.xls*")
        Do While strFile <> ""
            ' Open workbook
            Set wbk = Workbooks.Open(strPath & strFile)
            ' Call the macro
            Call MyMacro
            ' Close and save the workbook
            wbk.Close SaveChanges:=True
            ' On to the next workbook
            strFile = Dir
        Loop
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, January 21, 2015 8:14 PM
  • I ran your code on a folder with a few sample workbooks. As long as the active sheet in each workbook contains some data in columns A and B, the code runs fine.

    Perhaps some of the workbooks have no data in column A and/or B in the active worksheet?


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, January 22, 2015 3:45 PM

All replies

  • You have to write code for it. Let's say that you have a macro MyMacro that acts on the currently active workbook, and that you have placed all workbooks that you want to process in a single folder, with no other workbooks.

    Create the following macro in the same workbook that contains MyMacro:

    Sub ProcessFolder()
        Dim strPath As String
        Dim strFile As String
        Dim wbk As Workbook
        ' Let user select a folder
        With Application.FileDialog(4) ' msoFileDialogFolderPicker
            If .Show Then
                strPath = .SelectedItems(1)
                If Right(strPath, 1) <> "\" Then
                    strPath = strPath & "\"
                End If
            Else
                MsgBox "No folder specified. Exiting...", vbInformation
                Exit Sub
            End If
        End With
        ' Loop through the workbooks in the folder
        strFile = Dir(strPath & "*.xls*")
        Do While strFile <> ""
            ' Open workbook
            Set wbk = Workbooks.Open(strPath & strFile)
            ' Call the macro
            Call MyMacro
            ' Close and save the workbook
            wbk.Close SaveChanges:=True
            ' On to the next workbook
            strFile = Dir
        Loop
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, January 21, 2015 8:14 PM
  • Thanks, but I dont know how I should change it for my work.

    Let me say what i did !!

    I placed all Workbooks which I need in a "NewFolder" , and I opened one of them randomly and opened mymacro which its name is "Main" as module and then copied your code in Sheet1(sheet1) of workbook that I`ve opened then changed "MyMacro" to "Main" then it asked me to browse "NewFolder", after browsing I encountered an error  :

    "Run-time error 1004  Application-defined or Object-defined error"

    What should I do !?

    THANKS

    Wednesday, January 21, 2015 9:26 PM
  • What is the code of the Main macro?

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, January 21, 2015 10:17 PM
  • The Main code that I want to run for all workbooks is : 

        

    Sub Main()
      Dim ThisSheet As Worksheet, NewSheet As Worksheet
      Dim Where As Range, All As Range

      Dim Dict As Object 'Scripting.Dictionary
      Dim Key As String
      Dim Data, Keys
      Dim i As Long

      'Step 1: Analyse the data

      Set ThisSheet = ActiveSheet
      Set Dict = CreateObject("Scripting.Dictionary")
      'Read it all
      Data = Range("A1").CurrentRegion.Value
      For i = 2 To UBound(Data)
        'Build a key "X-Y"
        Key = Data(i, 1) & "-" & Data(i, 2)
        'Collect the unique keys
        If Not Dict.Exists(Key) Then Dict.Add Key, Array(Data(i, 1), Data(i, 2))
      Next

      'Step 2: Create the output

      Data = Dict.Items
      Keys = Dict.Keys
      For i = 0 To UBound(Data)
        With ThisSheet
          'Find all X in column A
          Set All = FindAll(.Columns("A"), Data(i)(0))
          'Get the cells in column B in the result rows
          Set Where = Intersect(All.EntireRow, .Columns("B"))
          'Find all Y
          Set All = FindAll(Where, Data(i)(1))
        End With


        'Prepare the existing sheet or create a new one
        If SheetExists(Keys(i)) Then
          Set NewSheet = Worksheets(Keys(i))
          'Clear previous results
          NewSheet.UsedRange.Clear
        Else
          Set NewSheet = Sheets.Add(After:=Sheets(Sheets.Count))
          NewSheet.Name = Keys(i)
        End If

        With NewSheet
          'Copy the header
          ThisSheet.Rows(1).Copy .Range("A1")
          'Copy the results to Sheet2
          All.EntireRow.Copy .Range("A2")
          .UsedRange.EntireColumn.AutoFit
        End With
      Next
    End Sub

    Private Function SheetExists(ByVal SheetNameOrIndex As Variant, _
        Optional ByVal Wb As Workbook = Nothing) As Boolean
      'True if sheet SheetNameOrIndex exists
      On Error Resume Next
      If Wb Is Nothing Then Set Wb = ActiveWorkbook
      SheetExists = Not Wb.Sheets(SheetNameOrIndex) Is Nothing
    End Function

    Private Function FindAll(ByVal Where As Range, ByVal What, _
        Optional ByVal After As Variant, _
        Optional ByVal LookIn As XlFindLookIn = xlValues, _
        Optional ByVal LookAt As XlLookAt = xlWhole, _
        Optional ByVal SearchOrder As XlSearchOrder = xlByRows, _
        Optional ByVal SearchDirection As XlSearchDirection = xlNext, _
        Optional ByVal MatchCase As Boolean = False, _
        Optional ByVal SearchFormat As Boolean = False) As Range
      'Find all occurrences of What in Where
      Dim FirstAddress As String
      Dim C As Range
      'From FastUnion:
      Dim Stack As Object 'Dictionary
      Dim Temp() As Variant
      Dim i As Long, j As Long

      If Where Is Nothing Then Exit Function
      If SearchDirection = xlNext And IsMissing(After) Then
        'Set After to the last cell in Where to return the first cell in Where in front if _
          it match What
        Set C = Where.Areas(Where.Areas.Count)
        'BUG in XL2010: Cells.Count produces a RTE 6 if C is the whole sheet
        'Set After = C.Cells(C.Cells.Count)
        Set After = C.Cells(C.Rows.Count * CDec(C.Columns.Count))
      End If

      Set C = Where.Find(What, After, LookIn, LookAt, SearchOrder, _
        SearchDirection, MatchCase, SearchFormat:=SearchFormat)
      If C Is Nothing Then Exit Function

      'Initialize our internal stack
      Set Stack = CreateObject("Scripting.Dictionary")

      FirstAddress = C.Address
      Do
        Stack.Add Stack.Count, C
        If SearchFormat Then
          'If you call this function from an UDF and _
            you find only the first cell use this instead
          Set C = Where.Find(What, C, LookIn, LookAt, SearchOrder, _
            SearchDirection, MatchCase, SearchFormat:=SearchFormat)
        Else
          If SearchDirection = xlNext Then
            Set C = Where.FindNext(C)
          Else
            Set C = Where.FindPrevious(C)
          End If
        End If
        'Can happen if we have merged cells
        If C Is Nothing Then Exit Do
      Loop Until FirstAddress = C.Address

      'FastUnion algorithm © Andreas Killer, 2011:
      'Get all cells as fragments
      Temp = Stack.Items
      'Combine each fragment with the next one
      j = 1
      Do
        For i = 0 To UBound(Temp) - j Step j * 2
          Set Temp(i) = Union(Temp(i), Temp(i + j))
        Next
        j = j * 2
      Loop Until j > UBound(Temp)
      'At this point we have all cells in the first fragment
      Set FindAll = Temp(0)
    End Function

    Thursday, January 22, 2015 8:43 AM
  • I ran your code on a folder with a few sample workbooks. As long as the active sheet in each workbook contains some data in columns A and B, the code runs fine.

    Perhaps some of the workbooks have no data in column A and/or B in the active worksheet?


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, January 22, 2015 3:45 PM
  • Ok you are right but how I have to use your code 1? ,just  I  have to copy your code before mine in one workbooks ?

    I want to know what changes you did on your code according to my code !? 

    Thanks . 

    Thursday, January 22, 2015 5:19 PM
  • I copied your code into a module in an Excel workbook, and did the same with the code that I posted. I made only one edit: I changed the line

            Call MyMacro

    to

            Call Main

    I then ran the ProcessFolder macro and pointed to the folder containing the Excel workbooks that I wanted to process when prompted.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, January 22, 2015 9:42 PM
  • Ok I ran this method, but it didn`t execute my all workbooks at the same time , it just started running one workbook and when it finished it started new one and so on . I need to run a special macro for all workbooks simultaneous.

    Thank you

     
    Friday, January 23, 2015 8:07 AM
  • That is impossible.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, January 23, 2015 11:45 AM
  • Ok Thank You Very Much.
    Friday, January 23, 2015 11:56 AM
  • Excel doesn't allow multithreading operations.

    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

    Saturday, January 24, 2015 7:07 PM