Sub Segregate()
Dim n As Long
Dim FName As Variant
Dim cell As Range, rngData As Range, rngMaster As Range
Dim dictData As Object
Dim wbMaster As Workbook, wbCand As Workbook
Dim ws As Worksheet, wsMaster As Worksheet, wsCand As Worksheet, wsFound As Worksheet, wsNotFound As Worksheet
Application.ScreenUpdating = False
Set wbMaster = ActiveWorkbook
Set wsMaster = wbMaster.Sheets("Master")
' This will let you select the Candidate workbook to work on
FName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", Title:="Select a File")
If FName = False Then Exit Sub 'CANCEL is clicked
' Define opened Workbook as wbCand while opening it.
Set wbCand = Workbooks.Open(Filename:=FName, UpdateLinks:=False)
Set wsCand = wbCand.Sheets("Candidates")
' Delete existing Found and NotFound sheetss if found
For Each ws In wbCand.Sheets
Select Case ws.Name
Case "Found", "NotFound"
ws.Delete
End Select
Next
Set wsFound = wbCand.Sheets.Add(After:=wsCand)
ActiveSheet.Name = "Found"
Set wsNotFound = wbCand.Sheets.Add(After:=wsFound)
ActiveSheet.Name = "NotFound"
Set dictData = CreateObject("Scripting.Dictionary")
Set rngData = wsCand.Range("A1", wsCand.Cells(Rows.Count, "A").End(xlUp))
Set rngMaster = wsMaster.Range("A2", wsMaster.Cells(Rows.Count, "A").End(xlUp))
For Each cell In rngMaster
If Not dictData.Exists(cell.Value) Then dictData.Add cell.Value, Nothing
Next
For Each cell In rngData
If dictData.Exists(cell.Value) Then
n = wsFound.Range("A" & Rows.Count).End(xlUp).Row + 1
wsCand.Range("A" & cell.Row, "D" & cell.Row).Copy wsFound.Range("A" & n)
Else
n = wsNotFound.Range("A" & Rows.Count).End(xlUp).Row + 1
wsCand.Range("A" & cell.Row, "D" & cell.Row).Copy wsNotFound.Range("A" & n)
End If
Next
Application.DisplayAlerts = False
wbCand.Save
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub