How to get unique combinations of two columns from multiple excel files?

Question

I have multiple excel sheets in a folder. They have columns "Department" and "Grade". I want to get the unique combinations of these two columns from all the files to a different excel workbook. For eg. if I have this in one file,

I should get:

And similarly, it should take only unique combinations of these two columns only from the remaining files. So if any of the remaining files contains "IT" and "P01", then it should be ignored as it is already there.

Answer 1

this will copy the values from each excel file to the activeworkbook

assuming the cell values are in column A and B of each files starting at row 2, modify path,source sheet name and destination sheet name accordingly

Sub MergeDataFromFiles()
    Dim filePath As String
    Dim fileName As String
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim lastRow As Long
    Dim sourceRow As Range
    Dim searchValue As String
    Dim foundRange As Range
    
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    ' Set the path to the folder containing the files
    filePath = "C:\Users\myuser\Documents\sample excel files\"
    
    ' Get the first file in the folder
    fileName = Dir(filePath & "*.xlsx")
    
    ' Loop through each file in the folder
    Do While fileName <> ""
        ' Open the file
        Set wbSource = Workbooks.Open(filePath & fileName)
        Set wsSource = wbSource.Sheets(1) ' Assuming the data is in the first sheet
        
        ' Get the last row in the active workbook
        lastRow = ActiveWorkbook.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
        
        ' Loop through each row in the source worksheet
        For Each sourceRow In wsSource.Range("A2:B" & wsSource.Cells(Rows.Count, "A").End(xlUp).Row)
            ' Concatenate values from columns A and B in the source workbook
            searchValue = sourceRow.Cells(1).Value & sourceRow.Cells(2).Value
            
            ' Find the concatenated value in the active workbook
            Set foundRange = ActiveWorkbook.Sheets(1).Range("A2:B" & lastRow).Find(searchValue, LookIn:=xlValues, LookAt:=xlWhole)
            
            ' If not found, copy the values to the next empty row in the active workbook
            If foundRange Is Nothing Then
                lastRow = lastRow + 1
                ActiveWorkbook.Sheets(1).Cells(lastRow, "A").Value = sourceRow.Cells(1).Value
                ActiveWorkbook.Sheets(1).Cells(lastRow, "B").Value = sourceRow.Cells(2).Value
            End If
        Next sourceRow
        
        ' Close the source workbook
        wbSource.Close SaveChanges:=False
        
        ' Get the next file in the folder
        fileName = Dir
    Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Msgbox "Copy complete."

End Sub