In 2 Excel worksheets, I am trying to eliminate duplicate entries

G

Guest

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?
 
G

Guest

Hopefully, 'duplicate' is based on a key value in a single cell. If so, the
MATCH function will help. In the larger table, create a helper column.
Suppose the key value is in column A, starting in row 2, and the helper
column will be B. In B2: =isna(match(a2,OtherSheet!A:A,false)). (Replace
'OtherSheet' with the name of the worksheet containing the smaller table, and
A:A with the column on that sheet containing the key values). Copy that
formula through column B. You'll have TRUE wherever there is NOT a match.
So use Data > Filter > Autofilter and select TRUE, delete the visible rows
and only those that are not duplicates will remain.
 
B

Bruno Campanini

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top