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 (e.g. 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 (e.g. 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

In your post you say "I want to make a macro", so...GO FOR IT AND CREATE IT! — Foxfire And Burns And Burns, Feb 21 '18 at 09:47
Now you say "Can anyone help me" so don't forget to read [Why is “Can someone help me?” not an actual question?](https://meta.stackoverflow.com/questions/284236/why-is-can-someone-help-me-not-an-actual-question). This is going to be a long day for you, my friend xD. Post the code you have tried, please. — Foxfire And Burns And Burns, Feb 21 '18 at 10:06
To be honest I don't have sufficient knowledge how to write vba code from scratch for such complex features, but I always tried to learn the codes from answers in here, at least I tried to understand the logic behind the code. For this case, this is way too steep for my knowledge haha :( Sure, for me today's almost over and yea it's a long day, Stack Overflow will gladly extend my day.. This is the only thing I could write which is the logic: Identify the value in A1:A5 column, scan the folder and loop, if match copy B9 & E9 from matched system generated workbook to B2 & C2 master's cell — Ghozian pribadi, Feb 21 '18 at 10:12
If you don't know VBA, then hire a developer. Anyways, about your problem. ¿Have you tried just liinking the workbooks? I mean, no need of VBA, you can type a formula to make reference to those cells, something like `='Z:\YourWorkbookFolder\[YourWorkbookName.xlsx]Worksheet'!$B$9` — Foxfire And Burns And Burns, Feb 21 '18 at 10:17
Hiring developer is a no go because of reasons. The problem is I have a master cell with >600 account number and >2000 of excel generated by system with random name so I have to open it one by one — Ghozian pribadi, Feb 21 '18 at 10:25
@Ghozianpribadi so somewhere in your root folder (e.g. C:\Work\2017) you have a file named by Account Number, such as 10001.xlsx? Also on the Master workbook, you have account numbers as 10001, 10002, etc. but on the second image you have the account number on the top as 1001?? Finally on the second image it says "Loan Provision" but on your last image it says "Loss Provision", please could you clarify these?? — Xabier, Feb 21 '18 at 11:49
@Xabier oops, sorry, take a look again I already fix it. No, I have files with random names that contains data like the 2nd pic — Ghozian pribadi, Feb 21 '18 at 12:28

Xabier · Accepted Answer · 2018-02-21T14:16:53.113

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.

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

1 Answers1