PDA

View Full Version : [SOLVED] Advanced Filter with duplicate deletions



sheeeng
06-28-2005, 01:50 AM
Sure surya, easy peasy...


Option Explicit

Sub TryThisNow()
Dim FirstEntry As String, M As Long, i As Long
Dim NextEntry As String, N As Long
i = 0
For M = 10 To [C65536].End(xlUp).Row
FirstEntry = Range("C" & M) & Range("D" & M) & _
Range("E" & M) & Range("G" & M) & _
Range("I" & M) & Range("J" & M)
For N = M + 1 To [C65536].End(xlUp).Row
NextEntry = Range("C" & N) & Range("D" & N) & _
Range("E" & N) & Range("G" & N) & _
Range("I" & N) & Range("J" & N)
If NextEntry <> Empty And NextEntry = FirstEntry Then
i = i + 1
Range("B" & N & ":" & "AO" & N).Interior.ColorIndex = 22
If Range("B" & M).Interior.ColorIndex <> 22 Then
Range("B" & M & ":" & "AO" & M).Interior.ColorIndex = 8
End If
End If
Next N
Next M
If i = 0 Then MsgBox "There are no duplicates"
End Sub



Hi johnske & all,

How can I delete duplicate row with these code..? :doh:
What does RED and BLUE stands for?

I need to remove entire duplicate row including Column A and Row 1.
Can I do this without add-in?

Please advise.

Thanks. :friends:

sheeeng
06-28-2005, 02:24 AM
Just an alternative,

Can anyone know how to use AdvancedFilter dunction to delete identical row?

I tried AdvancedFilter. But it only hide the identical row, which I do not need.

Please advise.

Thanks.

Zack Barresse
06-28-2005, 08:54 AM
FYI - Split from this thread: http://www.vbaexpress.com/forum/showthread.php?t=3628; as it substantiates it's own thread. :)

Bob Phillips
06-29-2005, 01:22 AM
Just an alternative,

Can anyone know how to use AdvancedFilter dunction to delete identical row?

I tried AdvancedFilter. But it only hide the identical row, which I do not need.

Please advise.

Thanks.

This is the approach I advocated



Sub DeleteRows()
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("G1").Value = "1"
Range("G2").Value = "2"
Range("G1:G2").AutoFill Destination:=Range("G1:G" & iLastRow)
Columns("A:F").Sort Key1:=Range("D1"), _
Order1:=xlAscending, _
Key2:=Range("E1"), _
Order2:=xlAscending, _
Key3:=Range("F1"), _
Order3:=xlAscending, _
Header:=xlNo
Columns("A:F").Sort Key1:=Range("A1"), _
Order1:=xlAscending, _
Key2:=Range("B1"), _
Order2:=xlAscending, _
Key3:=Range("C1"), _
Order3:=xlAscending, _
Header:=xlNo
Columns("H").Insert
Range("H1").Formula = _
"=(COUNTIF($A$1:A1,A1)+COUNTIF($B$1:B1,B1)+COUNTIF($C$1:C1,C1)+COUNTIF($D$1: D1,D1)+COUNTIF($E$1:E1,E1)+COUNTIF($F$1:F1,F1))>6"
Range("H1").AutoFill Destination:=Range("H1:H" & iLastRow), Type:=xlFillDefault
Rows("1:1").EntireRow.Insert
Range("H1").Value = "Temp"
Columns("H:H").AutoFilter Field:=1, Criteria1:="TRUE"
Rows("1:" & iLastRow + 1).SpecialCells(xlCellTypeVisible).Delete
Columns("A:G").Sort Key1:=Range("G1"), _
Order1:=xlAscending, _
Header:=xlNo
Columns("G:G").ClearContents
End Sub

sheeeng
06-29-2005, 02:09 AM
well done,xld.

but you had delete some with different data.

eg.
A B C Column

1 2 3
1 2 <-these u had deleted
1 3 <-by right, should not be deleted, because no identical rows found.
2 3
3 4 5

johnske
06-29-2005, 03:45 AM
Hi johnske & all,

How can I delete duplicate row with these code..? :doh:
What does RED and BLUE stands for?

I need to remove entire duplicate row including Column A and Row 1.
Can I do this without add-in?

Please advise.

Thanks. :friends:

Hi sheeeng,

To answer your 1st question in the thread (quoted)... The original code was required to colour the original blue and duplicates in red, looking in data on a row from column C onwards, (some of the cells in the attachment were merged).

A modification of that code to include data in columns A and B and delete dupes in the current workbook is shown below


Option Explicit

Sub TryThisNow2()
Dim FirstEntry As String, M As Long, i As Long
Dim NextEntry As String, N As Long
i = 0
Application.ScreenUpdating = False
For M = 1 To [C65536].End(xlUp).Row
FirstEntry = Range("A" & M) & Range("B" & M) & _
Range("C" & M) & Range("D" & M) & _
Range("E" & M) & Range("F" & M)
For N = M + 1 To [C65536].End(xlUp).Row
NextEntry = Range("A" & N) & Range("B" & N) & _
Range("C" & N) & Range("D" & N) & _
Range("E" & N) & Range("F" & N)
If NextEntry = FirstEntry Then
i = i + 1
Rows(N).Delete
N = N - 1 '< because 1 row has been deleted
End If
Next N
Next M
Application.ScreenUpdating = True
If i = 0 Then MsgBox "There are no duplicates"
End Sub

HTH,
John

Bob Phillips
06-29-2005, 03:55 AM
well done,xld.

but you had delete some with different data.

eg.
A B C Column

1 2 3
1 2 <-these u had deleted
1 3 <-by right, should not be deleted, because no identical rows found.
2 3
3 4 5

Sorry about the crappy testiung. Is this better



Sub DeleteRows()
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("G1").Value = "1"
Range("G2").Value = "2"
Range("G1:G2").AutoFill Destination:=Range("G1:G" & iLastRow)
Columns("A:F").Sort Key1:=Range("D1"), _
Order1:=xlAscending, _
Key2:=Range("E1"), _
Order2:=xlAscending, _
Key3:=Range("F1"), _
Order3:=xlAscending, _
Header:=xlNo
Columns("A:F").Sort Key1:=Range("A1"), _
Order1:=xlAscending, _
Key2:=Range("B1"), _
Order2:=xlAscending, _
Key3:=Range("C1"), _
Order3:=xlAscending, _
Header:=xlNo
Columns("H").Insert
Range("H1").Formula = _
"=SUMPRODUCT(--($A$1:A1&$B$1:B1&$C$1:C1&$D$1:D1&$E$1:E1&$F$1:F1=A1&B1&C1&D1&E1&F1))>1"
Range("H1").AutoFill Destination:=Range("H1:H" & iLastRow), Type:=xlFillDefault
Rows("1:1").EntireRow.Insert
Range("H1").Value = "Temp"
Columns("H:H").AutoFilter Field:=1, Criteria1:="TRUE"
Rows("1:" & iLastRow + 1).SpecialCells(xlCellTypeVisible).Delete
Columns("A:G").Sort Key1:=Range("G1"), _
Order1:=xlAscending, _
Header:=xlNo
Columns("G:G").ClearContents
End Sub

sheeeng
06-29-2005, 07:08 PM
Sorry, xld. Some unique data have been removed by your code.

eg.
1 2 3
1 2 <- these three must be kept because unique if compare whole row
2 3 <-
1 3 1
1 3 <-
1 2 <-duplicate, sure to remove

Immatoity
07-28-2005, 06:09 AM
hi....how could I do this but not delete the rows, but either sort by them, so all duplicates & orginials are at the top? Alternatively, how could I copy just the duplicates , once identified, into a new worksheet?

Bob Phillips
07-28-2005, 08:09 AM
hi....how could I do this but not delete the rows, but either sort by them, so all duplicates & orginials are at the top? Alternatively, how could I copy just the duplicates , once identified, into a new worksheet?

Add a helper column with a formula


=IF(COUNTIF(A:A,A1)>1,"Dup","")

and then just sort by the helper column

Immatoity
07-28-2005, 08:31 AM
thats brilliant....cheers