Thread: double records
View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Bruno Campanini
 
Posts: n/a
Default double records

"viktor" wrote in message
...
Hi,

How can i get the double records from one column with multiple
records(thousends)?


The following writes from TargetSource down, all duplicates found
in SourceRange down.
Just set your Source and Target ranges in Definitions.
=========================================
Sub WriteDuplicates()
Dim SourceRange As Range, TargetRange As Range
Dim i, j As Long, TestColl As New Collection

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

' Definitions
' ---------------------------------
Set SourceRange = [Sheet10!AA189]
Set TargetRange = [Sheet10!AB189]
' ---------------------------------
If Not IsEmpty(SourceRange(2, 1)) Then
Set SourceRange = SourceRange.Resize _
(SourceRange.End(xlDown).Row - SourceRange.Row + 1)
End If
For Each i In SourceRange
On Error GoTo WriteDuplicate
TestColl.Add i, CStr(i)
Continue:
Next

Exit_Sub:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub

WriteDuplicate:
j = j + 1
TargetRange(j, 1) = i
Resume Continue

End Sub
==========================
Ciao
Bruno