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
|