Option Explicit
Sub example()
Dim DIC1 As Object
Dim DIC2 As Object
Dim rngLRow As Range
Dim aryDataSheet1 As Variant
Dim aryDataSheet2 As Variant
Dim aryRet As Variant
Dim n As Long
Dim i As Long
Set DIC1 = CreateObject("Scripting.Dictionary")
Set DIC2 = CreateObject("Scripting.Dictionary")
With Sheet1 '<---Use CodeName or worksheet (tab) name ---> ThisWorkbook.Worksheets("Sheet1")
'// Find the last cell in Col B with data and set a reference. //
Set rngLRow = RangeFound(.Range(.Cells(2, "B"), .Cells(.Rows.Count, "B")))
'// If we didn't find data, bailout... //
If rngLRow Is Nothing Then Exit Sub
'// Plunk the vals into an array //
aryDataSheet1 = .Range(.Cells(2, "B"), rngLRow).Value
'// Release the reference so that we can see if we found data in the next sheet //
Set rngLRow = Nothing
End With
With Sheet2
Set rngLRow = RangeFound(.Range(.Cells(2, "F"), .Cells(.Rows.Count, "F")))
If rngLRow Is Nothing Then Exit Sub
aryDataSheet2 = .Range(.Cells(2, "F"), rngLRow).Value
'Set rngLRow = Nothing
End With
For n = 1 To UBound(aryDataSheet1, 1)
'// Loop thru the array, skipping blanks, and add to the dictionary keys. //
'// If the key does not exist, it is created. If it does exist, it's item is //
'// simply overwritten; thus, we get a list of unique values. //
If Not aryDataSheet1(n, 1) = Empty Then DIC1.Item(aryDataSheet1(n, 1)) = Empty
Next
For n = 1 To UBound(aryDataSheet2, 1)
If Not aryDataSheet2(n, 1) = Empty Then DIC2.Item(aryDataSheet2(n, 1)) = Empty
Next
'// Plunk both dictionary's keys into their respective arrays. //
aryDataSheet1 = DIC1.Keys
aryDataSheet2 = DIC2.Keys
'// Oversize an output array to hold the missing vals from both lists. //
ReDim aryRet(1 To Application.Max(DIC1.Count, DIC2.Count), 1 To 2)
'// Loop the missing items into the output array... //
For n = 0 To DIC1.Count - 1
If Not DIC2.Exists(aryDataSheet1(n)) Then
i = i + 1
aryRet(i, 2) = aryDataSheet1(n)
End If
Next
i = 0
For n = 0 To DIC2.Count - 1
If Not DIC1.Exists(aryDataSheet2(n)) Then
i = i + 1
aryRet(i, 1) = aryDataSheet2(n)
End If
Next
'// ...and plunk them somewheres. //
With ThisWorkbook.Worksheets.Add(After:=Sheet2, Type:=xlWorksheet)
.Range("A1:B1").Value = Array("Missing in List1", "Missing in List2")
.Range("A1:B1").Font.Bold = True
.Range("A2").Resize(UBound(aryRet, 1), 2).Value = aryRet
.Range("A1:B1").EntireColumn.AutoFit
End With
End Sub
Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range
If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If
Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function
