selecting duplicates using a macro to find them

mani_singh

Well-known Member
Joined
Jul 24, 2007
Messages
583
how can i select only duplicates using a macro?

i have a list in which i have a set of duplicate values i need to select only the duplicate ones using a macro to have them worked on

any ideas?
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

Lewiy

Well-known Member
Joined
Jan 5, 2007
Messages
4,284
Try this macro with your list in column A. Duplicates will be highlighted in red.
Code:
Sub Duplicates()
Dim limit As Long
Dim c As Long
limit = Cells(Rows.Count, 1).End(xlUp).Row
For c = 1 To limit
    If WorksheetFunction.CountIf(Range("A1:A" & c), Range("A" & c)) > 1 Then
        Cells(c, 1).Interior.ColorIndex = 3
    End If
Next c
End Sub
 

mani_singh

Well-known Member
Joined
Jul 24, 2007
Messages
583
thanks for that one. its helped but what i need to do is take this duplicate data and cross reference the values against it in a table

item -- person
K604 0
K604 1
K604 3
K604 1

needs to become -

item -- person - 0 - 1 - 2 - 3
K604 -- 1 - 2 - 0 - 1
 

Lewiy

Well-known Member
Joined
Jan 5, 2007
Messages
4,284
Perhaps like this then:
Code:
Sub SortMe()
Dim ColLimit As Long
Dim RowLimit As Long
Dim c As Long
Dim r As Long
RowLimit = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To RowLimit
    For c = 2 To RowLimit
        If Cells(r, 1) = Cells(c, 1) And r <> c Then
            ColLimit = Cells(r, Columns.Count).End(xlToLeft).Column
            Cells(r, ColLimit + 1) = Cells(c, 2)
        End If
    Next c
Next r
For r = RowLimit To 1 Step -1
    If WorksheetFunction.CountIf(Range("A1:A" & r), Range("A" & r)) > 1 Then
        Rows(r).Delete shift:=xlUp
    End If
Next r
End Sub
 

mani_singh

Well-known Member
Joined
Jul 24, 2007
Messages
583
thanks for the quick reply but i've set the macro up and nothing happens at all! i've put the data into a sheet with headings in col a and b set and run the macro no errors but no activity either!

any ideas what i'm doing wrong

thank you
 

Lewiy

Well-known Member
Joined
Jan 5, 2007
Messages
4,284
I start off with it looking like this:
Excel Workbook
AB
1ItemNumber
2Type395
3Type217
4Type353
5Type152
6Type117
7Type376
8Type383
9Type133
10Type256
11Type156
12Type398
13Type361
14Type288
15Type255
16Type122
17Type151
18Type218
19Type116
20Type175
Sheet2


And it ends up like this after running the macro:
Excel Workbook
C
7
Sheet1
 

Lewiy

Well-known Member
Joined
Jan 5, 2007
Messages
4,284
Sorry, second one looks like this:
Excel Workbook
ABCDEFGHI
1ItemNumber
2Type3955376839861
3Type21756885518
4Type15217335622511675
Sheet1
 

mani_singh

Well-known Member
Joined
Jul 24, 2007
Messages
583
Thanks for the quick reply - thats almost what im tryin to get done! nice one.

the format is correct but the data needs sorting - by this i mean in stead of just placing the numbers horizontaly against the item name (i think if i use cell values to explain it'll be clearer) ok:

columns:

a = item names
b = number - going ot be either 0,1,2 or 3 (can have multiple instances e.g. item 1 - 0, item 1 - 0, item 1 - 2 etc)

c = total number of 0 item numbers (added up in this column cell)
d = total number of 1's (same idea as above)
e = total number of 2's
f = total number ok 3's
g = total number all together
 

Lewiy

Well-known Member
Joined
Jan 5, 2007
Messages
4,284
Ok, I think I’m with you now. How about this:
Code:
Sub SortMe()
Dim ColLimit As Long
Dim RowLimit As Long
Dim c As Long
Dim r As Long
Dim PersonArray(3) As Long
RowLimit = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To RowLimit
    Cells(r, 3) = 0
    Cells(r, 4) = 0
    Cells(r, 5) = 0
    Cells(r, 6) = 0
    For c = 2 To RowLimit
        If Cells(r, 1) = Cells(c, 1) Then
            Select Case Cells(c, 2)
                Case 0
                    Cells(r, 3) = Cells(r, 3) + 1
                Case 1
                    Cells(r, 4) = Cells(r, 4) + 1
                Case 2
                    Cells(r, 5) = Cells(r, 5) + 1
                Case 3
                    Cells(r, 6) = Cells(r, 6) + 1
            End Select
        End If
    Next c
Next r
For r = RowLimit To 1 Step -1
    If WorksheetFunction.CountIf(Range("A1:A" & r), Range("A" & r)) > 1 Then
        Rows(r).Delete shift:=xlUp
    End If
Next r
End Sub
 

mani_singh

Well-known Member
Joined
Jul 24, 2007
Messages
583
Lewiy - thank you so much thats exactly what i needed to have done! - i owe you a drink!

ALL THE BEST !

MANI
 

Forum statistics

Threads
1,181,367
Messages
5,929,552
Members
436,677
Latest member
CathalP1992

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top