VBA Excel How to automatically compare multiple files to one master file then copy/paste the result

Question

https://postimg.org/image/laeyoj9wn/ = List

https://postimg.org/image/ihlr4i9k7/ = Master list

I would like to compare the List and Master list serial number. If there is similarity value in serial number the serial number value will be automatically paste on the third column

Sub AutoUpdate()
Dim Dic As Object, key As Variant, oCell As Range, i&
Dim w1 As Worksheet, w2 As Worksheet

    Set Dic = CreateObject("Scripting.Dictionary")
    Set w1 = Workbooks("Book1.xlsm").Sheets("Sheet1")
    Set w2 = Workbooks.Open("C:\UsersSurvey Testing\Book2.xlsx").Sheets("Sheet1")
    Set w3 = Workbooks.Open("C:\Users\Survey Testing\Book3.xlsx").Sheets("Sheet1")


    i = w2.Cells.SpecialCells(xlCellTypeLastCell).Row
    For Each oCell In w2.Range("A2:A" & i)
        If Not Dic.exists(oCell.Value) Then
            Dic.Add oCell.Value, oCell.Offset(, 0).Value
        End If

    Next
    i = w3.Cells.SpecialCells(xlCellTypeLastCell).Row
    For Each oCell In w3.Range("A2:A" & i)
        If Not Dic.exists(oCell.Value) Then
            Dic.Add oCell.Value, oCell.Offset(, 0).Value
        End If


    Next
    i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
    For Each oCell In w1.Range("A2:A" & i)
        For Each key In Dic
            If oCell.Value = key Then
                oCell.Offset(, 2).Value = Dic(key)
        End If


        Next
    Next

End Sub

Instead of setting the workbook 1 by 1 in the code, I would like to automatically find and set all the workbook in the folder and compare. Because there might be alot of workbook that need to be compare.

Answer 1

Conceptually, this can be done completely without VBA, using Power Query, a free Microsoft add-in for Excel 2010 and 2013 and built into Excel 2013 as Get and Transform.

Open all files in a folder, append them, remove duplicates and save as master file.

When new files are added, refresh the query.

Answer 2

Take a look at this question . From that code, yours will look something like the following:

Sub Compare()
Dim Dic As Object
Dim fso As Object 'FileSystemObject
Dim fldStart As Object 'Folder
Dim fl As Object 'File
Dim Mask As String, i As Long
Dim Wbk As Workbook

Set fso = New FileSystemObject
Set fld = fso.GetFolder("C:\UsersSurvey Testing")

Set Dic = CreateObject("Scripting.Dictionary")

Mask = "*.xlsx"

For Each fl in fld.Files
    If fl.Name Like Mask Then
        Set Wbk = Workbooks.Open(fld & "\" & fl.Name).Sheets("Sheet1")
        i = Wbk.Cells.SpecialCells(xlCellTypeLastCell).Row
        For Each oCell In Wbk.Range("A2:A" & i)
            If Not Dic.exists(oCell.Value) Then
                Dic.Add oCell.Value, oCell.Offset(, 0).Value
            End If
        Next oCell
    End If
Next fl
End Sub

Note: I have not tested this code. It's just to get you an idea of what to try.