jgentile said:
I have 2 worksheets one with 3100 row entries, another with 3700 row
entries.
The 3100 is duplicated in the 3700 and am trying to sort or eliminate the
duplicates only remaining with the 600 unique entires.
How do I do it?
The following code returns unique values for:
1 - entries in range A which are not in range B (A-B)
2 - entries in range B which are not in range A (B-A)
3 - entries in range A plus entries in range B (A+B)
4 - entries which are common to range A and range B (AB)
Just arrange Definitions to suit your needs.
==================================
Sub CompareData()
Dim CollA As New Collection
Dim CollB As New Collection
Dim CollA_B As New Collection
Dim CollB_A As New Collection
Dim CollAB As New Collection
Dim RaA As Range, RaB As Range
Dim TargetRange As Range
Dim CompareMode As String, i
' Definitions
' --------------------------------------------------
Set RaA = [Sheet10!W70]
Set RaB = [NameSheet!I32]
Set TargetRange = [Sheet10!X70]
CompareMode = "A-B" ' "A-B" | "B-A" | "A+B" | "AB"
'---------------------------------------------------
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
If Not IsEmpty(RaA(2, 1)) Then
Set RaA = RaA.Resize(RaA.End(xlDown).Row - RaA.Row + 1)
End If
If Not IsEmpty(RaB(2, 1)) Then
Set RaB = RaB.Resize(RaB.End(xlDown).Row - RaB.Row + 1)
End If
On Error Resume Next
For Each i In RaA
CollA.Add i, i
Next
For Each i In RaB
CollB.Add i, i
Next
On Error GoTo 0
Select Case CompareMode
Case "A-B", "A+B"
For Each i In CollA
On Error GoTo A_B
CollB.Add i, i
On Error Resume Next
CollA_B.Add i, i
ContinueA_B:
Next
On Error GoTo 0
If CompareMode = "A-B" Then
For i = 1 To CollA_B.Count
TargetRange(i) = CollA_B(i)
Next
Else
For i = 1 To CollB.Count
TargetRange(i) = CollB(i)
Next
End If
Case "B-A"
For Each i In CollB
On Error GoTo B_A
CollA.Add i, i
On Error Resume Next
CollB_A.Add i, i
ContinueB_A:
Next
On Error GoTo 0
For i = 1 To CollB_A.Count
TargetRange(i) = CollB_A(i)
Next
Case "AB"
For Each i In CollA
On Error GoTo AB
CollB.Add i, i
ContinueAB:
Next
On Error GoTo 0
For i = 1 To CollAB.Count
TargetRange(i) = CollAB(i)
Next
End Select
Exit_Sub:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
A_B:
Resume ContinueA_B
B_A:
Resume ContinueB_A
AB:
On Error Resume Next
CollAB.Add i, i
Resume ContinueAB
End Sub
=========================
Ciao
Bruno