CODEWITHSUNDEEP
vbaloopsexcel
JC11
JC11

Reputation: 473

Looping a code through a folder of workbooks with VBA?

I have a folder with a number of excel files all with the same format. I have modified the following code to determine the date and reformat it, where "i" determines the number of cells in the range based on the last row of column 2.

Sub Test()
   Dim i As Long
   i = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
   With Range("K3:K" & i)
        .Formula = "=DATE(A3,G3,H3)"
        .NumberFormat = "ddmmmyyyy"
   End With  
End Sub

I would like to perform this code on all the workbooks in my folder. I have found the following question on stackoverflow:

Code for looping through all excel files in a specified folder, and pulling data from specific cells

It does not loop through all my files, and only works on the first excel file I have opened. How can I loop this code through all workbooks in a folder? Below is what I have so far.

Sub Test()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim i As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
    Set wbCodeBook = ThisWorkbook
        With Application.FileSearch
            .NewSearch

            .LookIn = "C:\Test"
            .FileType = msoFileTypeExcelWorkbooks

                If .Execute > 0 Then
                    For lCount = 1 To .FoundFiles.Count

                        Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

   i = wbResults.Worksheets("Sheet1").Cells(wbResults.Worksheets("Sheet1").Rows.Count, 2).End(xlUp).Row
   With wbResults.Worksheets("Sheet1").Range("K3:K" & i)
        .Formula = "=DATE(A3,G3,H3)"
        .NumberFormat = "ddmmmyyyy"
   End With

                        wbResults.Close SaveChanges:=False
                    Next lCount
                End If
        End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Upvotes: 5

Views: 2326

Answers (2)

Matt C.
Matt C.

Reputation: 3290

This is inspired by Chris Newman's post on The Spreadsheet Guru
Copy and paste this entire code block, replacing the one line "wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)" with your specific code to be performed on each workbook.

Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Ensure Workbook has opened before moving on to next line of code
      DoEvents

'----------------------------------------------------------
'----------------------------------------------------------
'Here is where action code goes, what is going to be performed on each workbook
    'Change First Worksheet's Background Fill Blue
      wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
'----------------------------------------------------------
'----------------------------------------------------------

    'Save and Close Workbook
      wb.Close SaveChanges:=True

    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Upvotes: 0

Dmitry Pavliv
Dmitry Pavliv

Reputation: 35843

Application.FileSearch doesn't supported by Excel 2007 and later. Try this code (code for looping through files in a folder was taken from @mehow's site)

Sub PrintFilesNames()
    Dim file As String
    Dim wbResults As Workbook
    Dim i As Long
    Dim myPath As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    myPath = "D:\" ' note, path ends with back slash

    file = Dir$(myPath & "*.xls*")

    While (Len(file) > 0)
        Set wbResults = Workbooks.Open(Filename:=myPath & file, UpdateLinks:=0)

        With wbResults.Worksheets(Split(file, ".")(0))
            i = .Cells(.Rows.Count, 2).End(xlUp).Row
            With .Range("K3:K" & i)
                 .Formula = "=DATE(A3,G3,H3)"
                 .NumberFormat = "ddmmmyyyy"
            End With
        End With

        wbResults.Close SaveChanges:=True
        'get next file
        file = Dir
    Wend

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Upvotes: 4

Related Questions