requesting a macro

RSEKAR

Board Regular
Joined
Oct 18, 2010
Messages
172
Dear Sir,
I wish to have a macro to achieve the following requirements.
I have a list of names (text) in the range M10:M1000 column
The list may contain duplicate names also.
In the First step
The macro should delete the unique names from the list.
The remaining list will contain only duplicates (if present)
If there is no remaining text that shows the list contains only unique text and no duplicates were present.
In the Second step
If duplicates present the macro should delete the duplicates.
The final list should be unique text list arrived by deleting the duplicates.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p> Thanking you,</o:p>
<o:p>Yours sincerely,</o:p>
<o:p></o:p>
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
I'm confused...
In step 1 you want to end up with duplicates
then in step 2 you want to end up with uniques?
 
Upvote 0
Dear Sir,
Sorry I have not made you clear and I have confused you.
My requirement is I want a list of names which has duplicates in the original list.
Kindly forget about the step one and step two processing.
You can design the macro in such a way that I should get the list of names which have duplicates in the original list.
I hope I have made myself clear.
Thanking you, Sir,
 
Upvote 0
Not sure if this is what you need.
Note that blanks are ignored.
Rich (BB code):
Option Explicit

Sub ListDupeNamesFound()
    Dim x As Long, z As Long
    Dim listAll As Boolean
    Dim firstAddress
    Dim NameList As Range
    Dim FindList As Range
    Dim dupeList As Range
    
    'set listAll to False for individual Names that have at least 1 match
    'set listAll to True for Names and ALL the matches
    listAll = True
    
    Set NameList = Range("M10:M1000")
    Set FindList = NameList
    z = NameList.Cells(1, 1).Row - 1
    Range("N" & z + 1 & ":O" & NameList.Rows.Count).ClearContents
    Application.ScreenUpdating = False
    FindList.Select
    For x = 1 To NameList.Rows.Count
        If NameList.Cells(x, 1) <> "" Then
            Selection.Find(What:=NameList.Cells(x, 1), _
                After:=ActiveCell, _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlNext, _
                MatchCase:=False, _
                SearchFormat:=False).Activate
            firstAddress = ActiveCell.Address
            Selection.FindNext(After:=ActiveCell).Activate
            If ActiveCell.Address <> firstAddress Then
                z = z + 1
                Cells(z, 14) = NameList.Cells(x, 1)
                Cells(z, 15) = NameList.Cells(x, 1).Address(False, False)
            End If
        End If
    Next x
    NameList.Cells(1, 1).Select
    If z = NameList.Cells(1, 1).Row - 1 Then MsgBox "No Dupes Found": Exit Sub
    Set dupeList = Range("N" & NameList.Cells(1, 1).Row & ":O" & z)
    If listAll Then
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=dupeList.Columns(1), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
        With ActiveSheet.Sort
            .SetRange dupeList
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    Else
        dupeList.RemoveDuplicates Columns:=1, Header:=xlNo
    End If
End Sub
 
Upvote 0
Dear Sir,
I have tried your macro given. I get an error message while it is made to run.
Error message:
“Compile error: Variable not defined and the portion of the text (given within the brackets) in the macro has been selected.
SortOn:=((xlSortOnValues)), _<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
Kindly review
Thanking you, Sir,
 
Upvote 0
Runs fine here...

What ver XL you running?

After the line:
Code:
NameList.Cells(1, 1).Select
Insert:
Code:
Exit Sub

Try running again.

You should have the dupe results in Col "N" & cell addresses of dupes in Col "O".
Is this what you get?
 
Upvote 0
I have made the correction and inserted the code: Exit Sub in the place noted by you.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
Sorry I get the same error message and the same text has been selected and the macro is stopped with the error message.
I use Excel 2002 (10.2614.2625).
OS Windows XP
 
Upvote 0
Delete the last and try:
Rich (BB code):
Option Explicit

Sub ListDupeNamesFound()
    Dim x As Long, z As Long
    Dim listAll As Boolean
    Dim firstAddress
    Dim NameList As Range
    Dim FindList As Range
    Dim dupeList As Range
    
    'set listAll to False for individual Names that have at least 1 match
    'set listAll to True for Names and ALL the matches
    listAll = True
    
    Set NameList = Range("M10:M1000")
    Set FindList = NameList
    z = NameList.Cells(1, 1).Row - 1
    Range("N" & z + 1 & ":O" & NameList.Rows.Count).ClearContents
    Application.ScreenUpdating = False
    FindList.Select
    For x = 1 To NameList.Rows.Count
        If NameList.Cells(x, 1) <> "" Then
            Selection.Find(What:=NameList.Cells(x, 1), _
                After:=ActiveCell, _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlNext, _
                MatchCase:=False, _
                SearchFormat:=False).Activate
            firstAddress = ActiveCell.Address
            Selection.FindNext(After:=ActiveCell).Activate
            If ActiveCell.Address <> firstAddress Then
                z = z + 1
                Cells(z, 14) = NameList.Cells(x, 1)
                Cells(z, 15) = NameList.Cells(x, 1).Address(False, False)
            End If
        End If
    Next x
    NameList.Cells(1, 1).Select
    If z = NameList.Cells(1, 1).Row - 1 Then MsgBox "No Dupes Found": Exit Sub
    Set dupeList = Range("N" & NameList.Cells(1, 1).Row & ":O" & z)
    If listAll Then
        'Excel2002 sort code here
    Else
        dupeList.RemoveDuplicates Columns:=1, Header:=xlNo
    End If
End Sub
I have Excel07 so my sort code won't work for you.
I'm not sure what it needs to be, have a look around, it won't be hard to find.
 
Upvote 0

Forum statistics

Threads
1,214,652
Messages
6,120,746
Members
448,989
Latest member
mariah3

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
Back
Top