PDA

View Full Version : [SOLVED] Delete duplicate rows Excel 2003



Nicolaf
04-04-2014, 02:32 AM
Hi,

I have a code that deletes rows if text in column A is duplicated.


Sub DeleteDups()

Dim x As Long
Dim LastRow As Long

LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).EntireRow.Delete
End If
Next x

End Sub






I would like to change the code so that row is deleted if an identical row is found.
Rows have data in range A to C.

So for example for rows below in columns A to C:

apples green Italy
apples red Spain
apples green Italy
apples red Italy

Only row with "apples green Italy" should be deleted.

How do I amend my code to do this or is there another code I could use?
Unfortunately because I have Excel 2003
I cannot use







ActiveSheet.Range("$A$1:$C$4").RemoveDuplicates Columns:=Array(1, 2, 3), _
Header:=xlNoNix :(

GTO
04-04-2014, 03:10 AM
In your real workbook, how many rows of data are we looking at?

EDIT: For convenience (answerer's) could you post a workbook? You could delete from columns 4 and thereafter (if data is sensitive).

Bob Phillips
04-04-2014, 03:19 AM
Public Sub DeleteDuplicates()
Dim lastrow As Long
Dim rng As Range

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(1).Insert
.Columns("A").Insert
.Range("A1").Value = "tmp"
.Range("A2").Resize(lastrow).Formula = "=SUMPRODUCT(--(B$2:B2=B2),--(C$2:C2=C2),--(D$2:D2=D2))>1"
Set rng = .Range("A1").Resize(lastrow + 1)
rng.AutoFilter Field:=1, Criteria1:="=TRUE"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
.Columns(1).Delete
End With
End Sub

Nicolaf
04-04-2014, 06:54 AM
That's perfect.

thanks!
Nic
:hi::hi::hi: