Looping through each file in a folder

[Sandler]

I am looking for code that will loop through each file in a folder. This would be the shell for a program I am trying to create.

So far I know to pick the folder, i can use something like this

With Application.FileDialog(msoFileDialogFilePicker)

Thanks

 

[Fishboy]

I am looking for code that will loop through each file in a folder. This would be the shell for a program I am trying to create.

So far I know to pick the folder, i can use something like this

With Application.FileDialog(msoFileDialogFilePicker)

Thanks

Hi again Sandler,

Below is the general framework i tend to use when I need to loop through files in a folder. There is a big gap in the middle indicated by the row of ****************'s where you would put whatever code you need to happen on each file:

Sub CommentLength()
Dim wb As Workbook, wb2 As Workbook
Dim myPath As String, myFile As String, myExtension As String
Dim FldrPicker As FileDialog


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


' Sets wb as the master workbook
Set wb = ThisWorkbook


' 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 = "*.xlsm"


' 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 wb2 = Workbooks.Open(FileName:=myPath & myFile)
    
    ' With Sheet1 of the new workbook
    With wb2.Sheets(1)
        
****************************************
THE CODE TO RUN PER WORKBOOK GOES HERE
****************************************
        
    End With
    ' Close new workbook without saving
    wb2.Close False
    ' Get next file name
    myFile = Dir
' Next workbook in folder
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

 

[Sandler]

Fishboy always with the rescue.

Thank you, i forgot to mention that each worksheet has a password, the password is the same for all of them.
Hypothetically, we will say the password is "password"

This is the code that i have so far, but i need it to paste to the workbooks that I am newly creating to house the VBA code instead of a separate sheet in the macro I recorded and at every new worksheet in the loop I would need to offset it 1 row to add the new information.

Columns("M:M").Select
    Selection.AutoFilter
    ActiveSheet.Range("$M:$M").AutoFilter Field:=1, Criteria1:= _
        "Incentive"
    Range("A1").Select
    Cells.Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet ' add to original VBA workbook instead
    ActiveSheet.Paste

Thanks

 

[Fishboy]

Fishboy always with the rescue.

Thank you, i forgot to mention that each worksheet has a password, the password is the same for all of them.
Hypothetically, we will say the password is "password"

This is the code that i have so far, but i need it to paste to the workbooks that I am newly creating to house the VBA code instead of a separate sheet in the macro I recorded and at every new worksheet in the loop I would need to offset it 1 row to add the new information.

Columns("M:M").Select
    Selection.AutoFilter
    ActiveSheet.Range("$M:$M").AutoFilter Field:=1, Criteria1:= _
        "Incentive"
    Range("A1").Select
    Cells.Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet ' add to original VBA workbook instead
    ActiveSheet.Paste

Thanks

So, are we copying from all the workbooks we are looping through and pasting to the one containing the macros?

 

[Sandler]

Yes, each workbook in the folder has only 1 sheet. Since it has 1 sheet, I am assuming the sheet name does not matter.
And it's these workbooks in the folder that have the filtered information that i want to return to my VBA code workbook.
The VBA code workbook will only have a blank sheet to begin with.

Thanks

 

[Fishboy]

Yes, each workbook in the folder has only 1 sheet. Since it has 1 sheet, I am assuming the sheet name does not matter.
And it's these workbooks in the folder that have the filtered information that i want to return to my VBA code workbook.
The VBA code workbook will only have a blank sheet to begin with.

Thanks

Ok, so this is a bit thrown together without having a copy of your data workbooks to check the layout etc, but in general I think you would need something like this:

Sub Sandler()
Dim wb As Workbook, wb2 As Workbook
Dim myPath As String, myFile As String, myExtension As String
Dim FldrPicker As FileDialog
Dim RowCount As Long, LastRow As Long


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


' Sets wb as the master workbook
Set wb = ThisWorkbook
' Defines LastRow as the second blank row of data of Sheet1 of the master workbook
LastRow = wb.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 2


' 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 = "*.xlsm"


' 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 wb2 = Workbooks.Open(Filename:=myPath & myFile)
    
    ' With Sheet1 of the new workbook
    With wb2.Sheets(1)
        ' Unprotect the sheet
        .Unprotect "PASSWORD"
        ' Filter column M
        .Columns("M:M").AutoFilter
        ' Filter criteria is "Incentive"
        .Range("$M:$M").AutoFilter Field:=1, Criteria1:="Incentive"
        ' Select the visible cells only
        .Cells.SpecialCells(xlCellTypeVisible).Select
        ' Update variable RowCount with how many visible cells there were
        RowCount = Selection.SpecialCells(xlCellTypeVisible).Count
        ' Copy the selection
        Selection.Copy
        ' Paste the copied data to the second blank row on Sheet1 of the master workbook
        wb.Sheets(1).Range("A" & LastRow).Paste
        ' Increase LastRow by how many rows were just added
        LastRow = LastRow + RowCount
    End With


    ' Close new workbook without saving
    wb2.Close False
    ' Get next file name
    myFile = Dir
' Next workbook in folder
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

 

[Sandler]

Thank you so much for all your help.

 

[Fishboy]

Thank you so much for all your help.

No worries, happy to help

 

[Sandler]

I got a chance to test the code, and the following code is producing an overflow

' Update variable RowCount with how many visible cells there were
        RowCount = Selection.SpecialCells(xlCellTypeVisible).Count

Please, advise

 

[Fishboy]

I got a chance to test the code, and the following code is producing an overflow

' Update variable RowCount with how many visible cells there were
        RowCount = Selection.SpecialCells(xlCellTypeVisible).Count

Please, advise

Hi Sandler, sorry for the delay in my reply however I have not been well for the last few days so have not been checking the forums.

I am sorry to hear you are having trouble with the code I suggested. Are you able to share an example copy of the workbook with us so we can test it out? If so then you will need to upload a copy to a file hosting site such as Drop Box, One Drive, Google Drive or similar, then share a link to the file in a forum post. Once we have access to the example workbook we might be able to pin down what is causing the overflow.