Find the Double ID

[hakunamatata]

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.

[Bob Phillips]

Try this

[CatDaddy]

Sub check_Doubles()
Dim cell As Range
Dim col As String
Dim i, r, cr, lr, r3 As Integer
For i = 1 To 2
ActiveWorkbook.Sheets(i).Activate

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

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

ActiveWorkbook.Worksheets(i).Sort.SortFields.Clear
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
.Apply
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

[hakunamatata]

Thanks alot both of you.

[hakunamatata]

Hello Cat Daddy
Macro gives error on line
ActiveWorkbook.Worksheets(i).Sort.SortFields.Clear
object does not support this property or method.

[CatDaddy]

try changing it to sheets(i).sort.sortfields.clear

[hakunamatata]

thanks but still unlucky, same error on same line

[CatDaddy]

i have no idea i just tested it on the workbook you sent me and it worked fine

[hakunamatata]

Ok, thanks i will see it again tomorrow, then let you know.

[hakunamatata]

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.

[Bob Phillips]

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?

[hakunamatata]

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