Excel VBA Macro to match cell value from workbooks in a root folder then copy specific cell

Question

Picture above is the master workbook. Can anyone help me to write the vba so it will find workbooks throughout the root folder (eg C:\\Work\\2017) that match with the account number and copy the B9 and E9 cells to the master cell. The 2nd picture is a system generated workbook with random name (eg export!-097a0sdk.xls), that's why I need a shortcut to make this task easier.

This is the result I expected by using the code

This is the excel generated by system

Thank you

Answer 1

If I understood correctly then the following will loop through a given directory and it will open and check each file for the required information, if found, it will add the values to your Master workbook.

Note : This code will not open a file if it has "Master" in its filename.

Sub LoopThroughFolder()
Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim wb As Workbook
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim myFile As File
Dim AccNumber As String
Dim LastRow As Long, i As Long
Dim sPath As String
sPath = "C:\Work\2017"

LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Application.DisplayAlerts = False
'do not display alerts
Set myFolder = FSO.GetFolder(sPath) 'set the root folder
    For Each myFile In myFolder.Files 'for each file in the folder
        If InStr(myFile.Name, "Master") = 0 Then
        'if file to open does not have "Master" in it's name then
            Set wb = Workbooks.Open(myFile.Path) 'open the file
            AccNumber = wb.Sheets(1).Range("B2") 'check for account number on first Sheet
            For i = 1 To LastRow 'loop through current Sheet to check if we have a match for the account number
                If ws.Cells(i, 1) = AccNumber Then 'if match
                ws.Cells(i, 2) = wb.Sheets(1).Range("B9") 'pass the values from the required range
                ws.Cells(i, 3) = wb.Sheets(1).Range("E9")
                End If
            Next i
            wb.Close False 'close and do not save changes
            Set wb = Nothing
        End If
    Next
Application.DisplayAlerts = True
End Sub

Also you might have to set a reference to the relevant library to use FileSystemObject , to do that:

How do I use FileSystemObject in VBA?

Within Excel you need to set a reference to the VB script run-time library. The relevant file is usually located at \\Windows\\System32\\scrrun.dll

• To reference this file, load the Visual Basic Editor ( ALT + F11 )
• Select Tools > References from the drop-down menu
• A listbox of available references will be displayed
• Tick the check-box next to ' Microsoft Scripting Runtime '
• The full name and path of the scrrun.dll file will be displayed below the listbox
• Click on the OK button.