Copy all data into a new sheet.

Loop through each cell in one column, search the number with Range.Find in the other column.

Combine the cells in each column in a Range object using Union if found. The code below might be helpful for that.

After that you have 2 Range objects that refers to the double numbers in each column. Delete the Range object using Shift:=xlShiftUp

Andreas.

Function FindAll(ByVal Where As Range, ByVal What, _
Optional ByVal After As Variant, _
Optional ByVal LookIn As XlFindLookIn = xlValues, _
Optional ByVal LookAt As XlLookAt = xlWhole, _
Optional ByVal SearchOrder As XlSearchOrder = xlByRows, _
Optional ByVal SearchDirection As XlSearchDirection = xlNext, _
Optional ByVal MatchCase As Boolean = False, _
Optional ByVal SearchFormat As Boolean = False) As Range
'Find all occurrences of What in Where (Windows version)
Dim FirstAddress As String
Dim c As Range
'From FastUnion:
Dim Stack As New Collection
Dim Temp() As Range, Item
Dim i As Long, j As Long
If Where Is Nothing Then Exit Function
If SearchDirection = xlNext And IsMissing(After) Then
'Set After to the last cell in Where to return the first cell in Where in front if _
it match What
Set c = Where.Areas(Where.Areas.Count)
'BUG in XL2010: Cells.Count produces a RTE 6 if C is the whole sheet
'Set After = C.Cells(C.Cells.Count)
Set After = c.Cells(c.Rows.Count * CDec(c.Columns.Count))
End If
Set c = Where.Find(What, After, LookIn, LookAt, SearchOrder, _
SearchDirection, MatchCase, SearchFormat:=SearchFormat)
If c Is Nothing Then Exit Function
FirstAddress = c.Address
Do
Stack.Add c
If SearchFormat Then
'If you call this function from an UDF and _
you find only the first cell use this instead
Set c = Where.Find(What, c, LookIn, LookAt, SearchOrder, _
SearchDirection, MatchCase, SearchFormat:=SearchFormat)
Else
If SearchDirection = xlNext Then
Set c = Where.FindNext(c)
Else
Set c = Where.FindPrevious(c)
End If
End If
'Can happen if we have merged cells
If c Is Nothing Then Exit Do
Loop Until FirstAddress = c.Address
'FastUnion algorithm © Andreas Killer, 2011:
'Get all cells as fragments
ReDim Temp(0 To Stack.Count - 1)
i = 0
For Each Item In Stack
Set Temp(i) = Item
i = i + 1
Next
'Combine each fragment with the next one
j = 1
Do
For i = 0 To UBound(Temp) - j Step j * 2
Set Temp(i) = Union(Temp(i), Temp(i + j))
Next
j = j * 2
Loop Until j > UBound(Temp)
'At this point we have all cells in the first fragment
Set FindAll = Temp(0)
End Function