View Full Version : Find the Double ID

09-20-2012, 10:09 AM
Hello Everybody,
I want a macro which finds the double ID and when the double ID is found then it copy the double ID to the sheet3. For the sake of example workbook is attached with this thread, with an example.

09-20-2012, 11:09 AM
Try this

09-20-2012, 11:15 AM
Sub check_Doubles()
Dim cell As Range
Dim col As String
Dim i, r, cr, lr, r3 As Integer
For i = 1 To 2

If i = 1 Then
r = 6
col = "C"
r = 12
col = "H"
End If

lr = Range("C" & Rows.Count).End(xlUp).Row
r3 = 9

ActiveWorkbook.Worksheets(i).Sort.SortFields.Add Key:=Range("D" & r & ":D" & lr) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(i).Sort
.SetRange Range("A" & r - 1 & ":I" & lr)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
End With

For Each cell In Range("D" & r & ":D" & lr)
If cell.Value = cell.Offset(1, 0).Value Then cell.Offset(0, -3).Resize(2, 1).Value = "DOUBLE"
Next cell

For Each cell In Range("A" & r & ":A" & lr)
If cell.Value = "DOUBLE" Then
cr = cell.Row
Range("D" & cr & ",F" & cr & ",H" & cr).Copy Destination:=Sheets(3).Range(col & r3)
r3 = r3 + 1
End If
Next cell

Next i

End Sub

09-20-2012, 11:21 AM
Thanks alot both of you.

09-20-2012, 11:28 AM
Hello Cat Daddy
Macro gives error on line
object does not support this property or method.

09-20-2012, 11:33 AM
try changing it to sheets(i).sort.sortfields.clear

09-20-2012, 11:36 AM
thanks but still unlucky, same error on same line

09-20-2012, 11:38 AM
i have no idea i just tested it on the workbook you sent me and it worked fine

09-20-2012, 11:41 AM
Ok, thanks i will see it again tomorrow, then let you know.

09-20-2012, 11:36 PM
Hello CatdaddyNow i got the problem, actually i am using excel 2003 and sort fields function is for excel 2007. Is it possible to replace this sortfields function in such a way that it works in excel 2003 too.

09-21-2012, 02:51 AM
Just use

With ActiveWorkbook.Worksheets(i)

.Range("A" & r - 1 & ":I" & lr).Sort Key1:=.Range("D" & r - 1), Order1:=xlAscending, Header:=xlYes
End With

What was wrong with my formula solution?

09-21-2012, 11:49 PM
Hello Again,
The code which i have attached with the workbook is the modified form of the CatDaddy, Now it works fine but the problem is that it take the same column for both of the worksheets but i want different columns for both of the worksheets. Please take a look at the attached workbook