CODEWITHSUNDEEP
vbaexcelmacros
Ridwan
Ridwan

Reputation: 47

Excel VBA: How to Loop Through Workbooks in Same Folder using Given Code?

(Previous Post)

I need to create a macro that loops through the files that are in a single folder and runs the code that I have provided below. All the files are structured the same way however, have different data. The code helps me go to a specified destination file and counts the number of "YES" in the column. Then it outputs it into a CountResults.xlsm (master workbook). I have the following code with the help of Zac:

Private Sub CommandButton1_Click()

    Dim oWBWithColumn As Workbook: Set oWBWithColumn = Application.Workbooks.Open("C:\Users\khanr1\Desktop\CodeUpdateTest\Test01.xlsx")
    Dim oWS As Worksheet: Set oWS = oWBWithColumn.Worksheets("Sheet2")

    ThisWorkbook.Worksheets("Sheet1").Range("B2").Value = Application.WorksheetFunction.CountIf(oWS.Range("B:B"), "YES")

    oWBWithColumn.Close False

    Set oWS = Nothing
    Set oWBWithColumn = Nothing

End Sub

This is what the CountResults.xlsm (Master Workbook) looks like:

CountResults.xlsm

And, this is an example of what the Test01.xlsx looks like:

Test01.xlsx

To note, there are 10 test files (Test01, Test02...) but the code should be able to update any new test files added (ex. Test11, Test12...). I had an idea of incorporating the "Files" column in the first image to pull the file names and loop them.

Upvotes: 2

Views: 1041

Answers (2)

mozgov_net
mozgov_net

Reputation: 317

The easiest way to do so would be to use the filesystemobject to loop through all the files in the folder and find the ones where filename is similar to the predetrmined mask( in your case "Test*.xslx"). Please note that it also goes through subfolders in the specified folder. If that is not required, omit the first for each loop:

Dim fso As Object 'FileSystemObject
Dim fldStart As Object 'Folder
Dim fld As Object 'Folder
Dim fl As Object 'File
Dim oWBWithColumn As Workbook
Dim oWbMaster as workbook
Dim oWsSource as worksheet
Dim oWsTarget as worksheet
Dim Mask As String
Dim k as long
k=2
Set oWbMaster = ActiveWorkbook
Set oWsTarget = oWbMaster.Sheets("Sheet1")
Set fso = CreateObject("scripting.FileSystemObject")

Set fldStart = fso.GetFolder("C:\Users\khanr1\Desktop\CodeUpdateTest\")

Mask = "Test*" & ".xlsx"
For Each fld In fldStart.Subfolders

    For Each fl In fld.Files

    If fl.Name Like Mask Then

    Set oWBWithColumn = Application.Workbooks.Open(Filename:=fld.Path & "\" & fl.Name, ReadOnly:=True)
    Set oWsSource = oWBWithColumn.Worksheets("Sheet2")

        oWsTarget.Range("B"& k).Value = Application.WorksheetFunction.CountIf(oWsSource.Range("B:B"), "YES")

        oWBWithColumn.Close SaveChanges:=False
        k = k+1

    End If

Next

Next

If this answer helps, please mark as accepted. Also note that your original code would replace the value of B2 cell in the master spreadsheet every iteration of the loop, that's why I have added the k variable to change the target cell after each iteration

P.S.

You can generate a list of files along with the yes counts from the folder all at the same time, just add this line to the code before closing the file:

oWsTarget.Range("A"& k).Value= fl.Name

Upvotes: 1

user6432984
user6432984

Reputation:

The easiest thing to do is convert your code into a function. 

Private Sub CommandButton1_Click()
    Dim r As Range
    With Worksheets("Sheet1")
        For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
            r.Offset(0, 1).Value = getYesCount(r.Value)
        Next
    End With
End Sub

Function getYesCount(WorkBookName As String) As Long
    Const FolderPath As String = "C:\Users\khanr1\Desktop\CodeUpdateTest\"

    If Len(Dir(FolderPath & WorkBookName)) Then
        With Workbooks.Open(FolderPath & WorkBookName)
            With .Worksheets("Sheet2")
                getYesCount = Application.CountIf(.Range("B:B"), "YES")
            End With
            .Close False
        End With
    Else
        Debug.Print FolderPath & WorkBookName; ": Not Found"
    End If
End Function

Upvotes: 0

Related Questions