code to remove row duplications

D

david shapiro

I`d like to use this code to remove all duplicate rows in a dataset and
then to run it in a number of worksheets with datasets of varying size
(rows and columns) where the range is changing. I`ve used the advanced
filter (unique) option. But the code is not working. Anyone know the
right code for this?

sheets ("sheet1").select
range("A1").CurrentRegion.select.advancedfilter Action:=xlfiltercopy,_
copytorange:=range(???), Unique:=true

David Shapiro



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
 
N

Norman Jones

Hi David,
I`ve used the advanced filter (unique) option.
But the code is not working

Your problem may reside in the fact that, in order to extract the filter
data to another sheet, it is necessary to set up the filter operation from
the destination sheet.

See the section: Extract Data to Another Worksheet

on Debra Dalgleish's Advanced Filter page

http://www.contextures.com/xladvfilter01.html
 
D

david shapiro

Norman,

Thanks for the suggestion, it`s good to know about that page. I checked
this page, and I`d like to put this code except that I`d like to delete
duplicate rows which are identical.

I think this code (copied below) duplicates on the basis of selected
columns. Is there some way to alter this code so that it deletes
duplicate rows?

David

Public Sub DeleteDuplicateRows()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.

Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Col = ActiveCell.Column

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If
Next r

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub






*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
 
D

david shapiro

Re: code to remove row duplications
From: david shapiro
Date Posted: 9/20/2004 8:03:00 AM

Frank, sorry actually had intended to send this to you. Any ideas on
the below?

Dave


Norman,
Thanks for the suggestion, it`s good to know about that page. I checked
this page, and I`d like to put this code except that I`d like to delete
duplicate rows which are identical.

I think this code (copied below) duplicates on the basis of selected
columns. Is there some way to alter this code so that it deletes
duplicate rows?

David

Public Sub DeleteDuplicateRows()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.

Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Col = ActiveCell.Column

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If
Next r

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub





*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
 
N

Norman Jones

Hi David,

Your code, which was originally supplied by Chip Pearson, does delete rows.
It uses the active column to determine duplication.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top