Deleting Duplicate Rows
Posted by Thomas McCabe on April 25, 2001 2:06 PM
I have a very large spreadsheet - 9 cols X 9000 rows.
The data is imported and many rows are duplicates. How can I have the duplicate rows deleted with a macro. I hope someone can help.
Thanks
Posted by IML on April 25, 2001 2:12 PM
possible non-macro way
Could you get away with highlighting your data and going to
Data - filter - advanced filter
Select copy to another place and check unique records only.
If no-one else resonds, check out Dave's Hawleys site (link on any of responses) He has a section devoted to dealing with duplicates.
good luck
Ian
Posted by Dave Hawley on April 25, 2001 4:43 PM
Hi Thomas
As Ivan has suggested Excels Advanced filter is by far the quickest way to handle this. The code below will simply automate the task.
Sub DuplicatesGo()
'Written by OzGrid Business Applications
'www.ozgrid.com
''''''''''''''''''''''''''''''''''''''''''
'Extract unique entries only
''''''''''''''''''''''''''''''''''''''''''
Dim RUniqueCells As Range
With Sheet1
'Set Range variable to all entries
Set RUniqueCells = Range(.Range("A1"), .Range("A65536").End(xlUp))
'Advance filter to remove duplicates
RUniqueCells.AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("B1"), unique:=True
End With
'Release memory
Set RUniqueCells = Nothing
End Sub
Dave
OzGrid Business Applications
Posted by Thomas McCabe on April 26, 2001 7:59 AM
Dave, thanks for the help. This routine filters the criteria column correctly, but only copies that column. Is there a way to copy all the unique rows with one column as the criteria for uniqueness?
Thanks
Posted by Dave Hawley on April 26, 2001 7:36 PM
Thomas, yes there is! This code will do so and place the results on a new sheet it creates.
Sub DuplicatesGo()
'Written by OzGrid Business Applications
'www.ozgrid.com
''''''''''''''''''''''''''''''''''''''''''
'Create a Worksheet
'Extract unique entries only
'Then copy the entire rows to
'the new sheet
''''''''''''''''''''''''''''''''''''''''''
Dim RUniqueCells As Range
'Add a new sheet and name it
'If already exists then rename it
On Error Resume Next
Sheets.Add().Name = "Unique Copies"
If ActiveSheet.Name <> "Unique Copies" Then
ActiveSheet.Name = "Unique Copies" & Sheets.Count
End If
On Error GoTo 0
With Sheet1
'Set Range variable to all entries
Set RUniqueCells = Range(.Range("A1"), .Range("A65536").End(xlUp))
'Advance filter to remove duplicates
RUniqueCells.AdvancedFilter _
Action:=xlFilterInPlace, unique:=True
.UsedRange.SpecialCells(xlCellTypeVisible).Copy _
Destination:=ActiveSheet.Range("A1")
.ShowAllData
End With
Application.CutCopyMode = False
'Release memory
Set RUniqueCells = Nothing
End Sub
OzGrid Business Applications
