Removing multiples from data

If you have 2010 then the remove duplicates feature should do all you want it to.

I don't think remove duplicates covers all that you asked but there is a way to achieve this without VBA (though you could record this as a macro as a starting point if that is important).

after making a copy of the original sheet (the copy will become your 'after macro' sheet in the example
1. choose the new sheet and Sort on the column you want to work with (make sure  'my data has headers' is checked)
2. use Highlight duplicates and choose a colour (pale red is default)
3. select the whole table and turn on autofilter
4. Filter the target column on colour - choosing the pale red
5. Select the resulting set and press ALT+; then COPY to another sheet (your multiples sheet)
6. return to the copied sheet and press Del (removing the multiples you just copied)
7. Clear the autofilter
8. Resort the table without the duplicated sets
9. Delete the blank rows

Thanks for the comments.  It is good to know the manual method but I rather have code which I can execute at the press of a button and have the process done in seconds.

Try this to see if this is what you are trying to achieve..

Sub CopyUniqueRecordsOnly()
Dim Col As Long, lr As Long, i As Long
Dim cell As Range
Dim Sum As String
Set cell = Application.InputBox(prompt:="Please select a cell in the target column for finding unique records.", Title:="Select The Colunm!", Type:=8)
Col = cell.Column
lr = Sheet1.Cells(Rows.Count, Col).End(xlUp).Row
If Sheet2.UsedRange.Rows.Count > 1 Then
   Sheet2.Rows("2:1048576").Clear
End If
With Sheet1
   For i = 2 To lr
      If WorksheetFunction.CountIf(Sheet1.Columns(Col), Sheet1.Cells(i, Col)) = 1 Then
         Sheet1.Cells(i, Col).EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
      End If
   Next i
End With
lr = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
Sum = "SUM(A2:A" & lr - 1 & ")"
Sheet2.Cells(lr, 1).Formula = "=" & Sum
Sheet2.Activate
MsgBox "All the unique records are copied to the Sheet2 successfully.", vbInformation, "Done!"
End Sub

Select allOpen in new window

Click on the button on Sheet1 to get the desired output on Sheet2.
Copy-of-Multiples.xlsm

SK, macro appears to work.  I also needed the "multiples" rows copied over to Sheet3.  I don't think your code does that as yet.  Thanks.