PDA

View Full Version : Find the Double ID



hakunamatata
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.

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

CatDaddy
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
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
09-20-2012, 11:21 AM
Thanks alot both of you.

hakunamatata
09-20-2012, 11:28 AM
Hello Cat Daddy
Macro gives error on line
ActiveWorkbook.Worksheets(i).Sort.SortFields.Clear
object does not support this property or method.

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

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

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

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

hakunamatata
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.

xld
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?

hakunamatata
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