Hi Everyone,


I am trying to find a way to compare two columns of numbers. Eac
column contains about 2,500 rows of numbers and I want to know wha
numbers appear in one column and not the other.

Ex:

Column A Column B

1234 3424
4324 4324
5435 5345
6564 1234
3242 6546
5435 7657


I want to know two things:

1. What numbers appear in Column A and not in Column B.
2. What numbers appear in Column B and not Column A.

Is there anything out there that can do this? Most things I have foun
so far compare the rows side by side. I dont care about the order th
numbers are in.

Thank

--
Patty
-----------------------------------------------------------------------
PattyB's Profile: http://www.excelforum.com/member.php...fo&userid=1473
View this thread: http://www.excelforum.com/showthread.php?threadid=26353

in C1 put in the formula
=if(countif($B:$B,A1)=0,"Only in A","")
in D1 put in the formula
=if(countif($A:$A,B1)=0,"Only in B","")

then select C1 and D1 and drag fill down the column.

You can then apply an autofilter to column C and then Column D, each time
copying only the visible cells in A, then B

--
Regards,
Tom Ogilvy


"PattyB" wrote in message
...

Hi Everyone,


I am trying to find a way to compare two columns of numbers. Each
column contains about 2,500 rows of numbers and I want to know what
numbers appear in one column and not the other.

Ex:

Column A Column B

1234 3424
4324 4324
5435 5345
6564 1234
3242 6546
5435 7657


I want to know two things:

1. What numbers appear in Column A and not in Column B.
2. What numbers appear in Column B and not Column A.

Is there anything out there that can do this? Most things I have found
so far compare the rows side by side. I dont care about the order the
numbers are in.

Thanks


--
PattyB
------------------------------------------------------------------------
PattyB's Profile:
http://www.excelforum.com/member.php...o&userid=14734
View this thread: http://www.excelforum.com/showthread...hreadid=263531

As Tom Ogilvy said we use countif formula to compare two lists but if the
lists are long ( more than 10000 ) it take some time to do the job. This
macro Compare2Lists() is very fast and gives a comprehensive report.
In a new workbook with 3 sheets, Put the List1 in "Sheet1" columnA with a
header in A1,
List2 in "Sheet2" as above and put this code (all of them) in a general
module and run the macro
Compare2Lists()
Would like to here comments from interested parties, Please.
Cecil

Option Explicit

Sub Compare2Lists()

Dim LRow As Long
Sheets("Sheet3").Cells.Clear

GettingValues

Range("B1").Formula = "Tag"
'Find the last row with data
LRow = Range("A" & Rows.Count).End(xlUp).Row

'sort the list and tag the duplicates
Range("A1:B" & LRow).Sort Key1:=Range("A2"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

TagDuplicates

FilterUniques_Duplicates

Indexing

Reporting

End Sub

Sub GettingValues()
Dim i As Single
Dim varr() As Variant
Application.ScreenUpdating = False

varr() = Array("L1", "L2")

For i = 1 To 2
Sheets("Sheet" & i).Select
Range("B1:Z" & Rows.Count).ClearContents
ExtractUniques_Duplicates

Sheets("Sheet3").Range("A1").Value = Range("A1").Value
Sheets("Sheet3").Range("B1").Value = varr(i - 1)

TagCases

Next i

Application.ScreenUpdating = True

Sheets("Sheet3").Select
End Sub

Sub ExtractUniques_Duplicates()
Dim LRow As Long
Dim LRDups As Long
Dim FRdEl As Long
Dim spt As Integer
Dim varr() As Variant
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False

SortList

TagDuplicates

FilterUniques_Duplicates

'Tag the duplicates to delete while keeping the last one
LRDups = Range("L" & Rows.Count).End(xlUp).Row
With Range("O3")
.Formula = "=IF(N4=N3+1,""dEl"",N3)"
.AutoFill Destination:=Range("O3:O" & LRDups)
End With
With Range("O3:O" & LRDups)
.Copy
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False

spt = 3
For i = 3 To LRDups
If IsNumeric(Range("O" & i).Value) Then
For j = spt To i
Range("P" & i).Value = Range("P" & i).Value & _
Range("M" & j).Value & ","
Next j
spt = i + 1
End If
Next i

Range(Cells(2, 12), Cells(LRDups, 16)).Sort _
Key1:=Range("O3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'Delete the duplicates but keep one of each
If Evaluate("Counta(L3:L5)") 1 Then
Range("A1").Select
Cells.Find(What:="dEl", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
FRdEl = ActiveCell.Row
Range("L" & FRdEl & ":P" & LRDups).ClearContents
End If
'Headers
Range("J1").Value = "Unique"
Range("L1").Value = "Duplicate"
Range("N2").Value = "Count"
Range("P2").Value = "InRows"

SortBack

'Cleanup
varr() = Array("C:I", "M", "O")
For i = UBound(varr()) To LBound(varr()) Step -1
Columns(varr(i)).Delete
Next i
Range("B1").EntireColumn.ClearContents
Range("A1").Select

Application.ScreenUpdating = True

End Sub


Sub SortList()
Dim LRow As Long
LRow = Range("A" & Rows.Count).End(xlUp).Row
'This macro will sort the list so
'Put an index column to sort back to the original
Range("B1").Formula = "Row"
With Range("B2")
.Formula = "=ROW()"
.AutoFill Destination:=Range("B2:B" & LRow)
End With
With Range("B2:B" & LRow)
.Copy
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False
Range("A1:B" & LRow).Sort Key1:=Range("A2"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End Sub


Sub SortBack()
Dim LRow As Long
LRow = Range("A" & Rows.Count).End(xlUp).Row
'sort back the list
Range("A1:B" & LRow).Sort Key1:=Range("B2"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

End Sub


Sub TagDuplicates()
Dim LRow As Long
LRow = Range("A" & Rows.Count).End(xlUp).Row

Range("C1").Formula = "1"
With Range("C2")
.Formula = "=IF(A2=A1,C1+1,1)"
.AutoFill Destination:=Range("C2:C" & LRow)
End With
Range("D1").Formula = "Unique"
With Range("D2")
.Formula = "=IF(C2=C3,1,0)"
.AutoFill Destination:=Range("D2:D" & LRow)
End With
With Range("C2:D" & LRow)
.Copy
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False
If Range("C" & LRow).Value = 1 Then _
Range("D" & LRow).Value = 1

End Sub


Sub FilterUniques_Duplicates()
Dim LRow As Long
LRow = Range("A" & Rows.Count).End(xlUp).Row
'Use advanced filter to extract unique and duplicate list
Range("J2").Value = Range("A1").Value
Range("K2").Value = Range("B1").Value
Range("F2").Value = Range("D1").Value
Range("F3").Value = 1

Range("A1:D" & LRow).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("F2:F3"), _
CopyToRange:=Range("J2:K2"), unique:=False

Range("L2").Value = Range("A1").Value
Range("M2").Value = Range("B1").Value
Range("N2").Value = Range("C1").Value
Range("F3").Value = 0

Range("A1:D" & LRow).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("F2:F3"), _
CopyToRange:=Range("L2:N2"), unique:=False

End Sub

Sub TagCases()
Dim LRow As Long
Dim StRow As Long

LRow = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
StRow = LRow + 1
If Evaluate("Counta(C3:C5)") 1 Then
Range(Range("C3"), _
Range("C3").End(xlDown)).Copy _
Destination:=Sheets("Sheet3").Range("A" & StRow)
Application.CutCopyMode = False
LRow = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet3").Range("B" & StRow).Value = _
Sheets("Sheet3").Range("B1").Value & "U"
Sheets("Sheet3").Range("B" & StRow).AutoFill _
Destination:=Sheets("Sheet3").Range("B" & StRow & ":B" & LRow)
StRow = LRow + 1
ElseIf Evaluate("Counta(C3:C5)") = 1 Then
Sheets("Sheet3").Range("A" & StRow).Value = Range("C3").Value
LRow = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet3").Range("B" & StRow).Value = _
Sheets("Sheet3").Range("B1").Value & "U"
StRow = LRow + 1
Else
LRow = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
StRow = LRow + 1
End If

If Evaluate("Counta(E3:E5)") 1 Then
Range(Range("E3"), _
Range("E3").End(xlDown)).Copy _
Destination:=Sheets("Sheet3").Range("A" & StRow)
Application.CutCopyMode = False
LRow = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet3").Range("B" & StRow).Value = _
Sheets("Sheet3").Range("B1").Value & "D"
Sheets("Sheet3").Range("B" & StRow).AutoFill _
Destination:=Sheets("Sheet3").Range("B" & StRow & ":B" & LRow)
StRow = LRow + 1
ElseIf Evaluate("Counta(E3:E5)") = 1 Then
Sheets("Sheet3").Range("A" & StRow).Value = Range("E3").Value
LRow = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet3").Range("B" & StRow).Value = _
Sheets("Sheet3").Range("B1").Value & "D"
StRow = LRow + 1
Else
LRow = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
StRow = LRow + 1
End If

End Sub


Sub Indexing()
Dim LRowDups As Long
Dim i As Long
Application.ScreenUpdating = False
LRowDups = Range("L" & Rows.Count).End(xlUp).Row
For i = LRowDups To 3 Step -1
If Range("L" & i).Value = Range("L" & i - 1).Value Then
Range("M" & i - 1).Value = _
Range("M" & i - 1).Value & Range("M" & i).Value
Range("M" & i).ClearContents
End If
Next i
Application.ScreenUpdating = True
End Sub


Sub Reporting()
Dim LRow As Long
Dim LRowDups As Long
Dim i As Long
Dim varr() As Variant
Dim legend() As Variant
Dim rng As Range
Application.ScreenUpdating = False
varr() = Array("L1U", "L1D", "L2U", "L2D", _
"L1UL2U", "L1UL2D", "L1DL2U", "L1DL2D")
Range("O2").Value = Range("B1").Value
LRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:I" & LRow).ClearContents
LRow = Range("J" & Rows.Count).End(xlUp).Row
LRowDups = Range("L" & Rows.Count).End(xlUp).Row
Range("O2").Value = Range("K2").Value
Set rng = Range("J2:K" & LRow)
For i = 1 To 8
Cells(1, i).Value = varr(i - 1)
Range("O3").Value = varr(i - 1)
Cells(2, i).Value = Range("J2").Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("O2:O3"), _
CopyToRange:=Range(Chr(64 + i) & 2), unique:=False
If i = 4 Then
Set rng = Range("L2:M" & LRowDups)
End If
Next i
Range("J2:O" & LRow).EntireColumn.Delete
Range("A1").Select
legend() = Array( _
"Items unique to List1", _
"Items unique to List1 but appear more than once", _
"Items unique to List2", _
"Items unique to List2 but appear more than once", _
"Items appear once in both Lists", _
"Items appear once in list1 and more than once in List2", _
"Items appear once in list2 and more than once in List1", _
"Items appear more than once in both Lists")
For i = 0 To 7
Range("J" & i + 3).Value = varr(i)
Range("K" & i + 3).Value = legend(i)
Next i
Application.ScreenUpdating = True
End Sub

"PattyB" wrote in message
...

Hi Everyone,


I am trying to find a way to compare two columns of numbers. Each
column contains about 2,500 rows of numbers and I want to know what
numbers appear in one column and not the other.

Ex:

Column A Column B

1234 3424
4324 4324
5435 5345
6564 1234
3242 6546
5435 7657


I want to know two things:

1. What numbers appear in Column A and not in Column B.
2. What numbers appear in Column B and not Column A.

Is there anything out there that can do this? Most things I have found
so far compare the rows side by side. I dont care about the order the
numbers are in.

Thanks


--
PattyB
------------------------------------------------------------------------
PattyB's Profile:
http://www.excelforum.com/member.php...o&userid=14734
View this thread: http://www.excelforum.com/showthread...hreadid=263531

as a (fast/quick and dirty) alternative...

try following:
tested with 2 ranges of 10000 random integer numbers
it completes in <2 seconds.

it returns 3 (sorted) lists:
numbers unique to list 1
numbers shared
numbers unique to list 2



Option Explicit

Sub Analyse()
Dim col(3) As Collection
Dim arr(3) As Variant
Dim tmp As Collection
Dim itm As Variant
Dim n&, i&

For n = 0 To 2
Set col(n) = New Collection
Next

On Error Resume Next
'Fill tmp
Set tmp = New Collection
For Each itm In Range("a1:A10000")
tmp.Add itm.Value2, CStr(itm.Value2)
Next

For Each itm In Range("b1:b10000")
If IsError(tmp(CStr(itm.Value2))) Then
'Right join
col(2).Add itm.Value2, CStr(itm.Value2)
Else
'Inner join
col(1).Add itm.Value2, CStr(itm.Value2)
End If
Next
For Each itm In tmp
If IsError(col(1)(CStr(itm))) Then
'Left join
col(0).Add itm, CStr(itm)
End If
Next
Set tmp = Nothing
For n = 0 To 2
arr(n) = col2arr(col(n))
qSort arr(n)
Next

Range("c1").Resize(col(0).Count) = Application.Transpose(arr(0))
Range("d1").Resize(col(1).Count) = Application.Transpose(arr(1))
Range("e1").Resize(col(2).Count) = Application.Transpose(arr(2))

End Sub

Function col2arr(col As Collection) As Variant()
Dim n&, res
With col
ReDim res(1 To .Count)
For n = 1 To .Count
res(n) = col(n)
Next
End With
col2arr = res
End Function

Public Sub qSort(v, Optional n& = True, Optional m& = True)
Dim i&, j&, p, t
If n = True Then n = LBound(v): If m = True Then m = UBound(v)
i = n: j = m: p = v((n + m) \ 2)
While (i <= j)
While (v(i) < p And i < m): i = i + 1: Wend
While (v(j) p And j n): j = j - 1: Wend
If (i <= j) Then
t = v(i): v(i) = v(j): v(j) = t
i = i + 1: j = j - 1
End If
Wend
If (n < j) Then qSort v, n, j
If (i < m) Then qSort v, i, m
End Sub



keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


PattyB wrote:


Hi Everyone,


I am trying to find a way to compare two columns of numbers. Each
column contains about 2,500 rows of numbers and I want to know what
numbers appear in one column and not the other.

Ex:

Column A Column B

1234 3424
4324 4324
5435 5345
6564 1234
3242 6546
5435 7657


I want to know two things:

1. What numbers appear in Column A and not in Column B.
2. What numbers appear in Column B and not Column A.

Is there anything out there that can do this? Most things I have
found so far compare the rows side by side. I dont care about the
order the numbers are in.

Thanks

wow,
this stuff is amazing....
Thanks

--
syaron
-----------------------------------------------------------------------
syaronc's Profile: http://www.excelforum.com/member.php...fo&userid=1026
View this thread: http://www.excelforum.com/showthread.php?threadid=26353