Advanced Filter with duplicate deletions

Quote:

---

Originally Posted by johnske

Sure surya, easy peasy...

Code:

---

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:

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.

FYI - Split from this thread: http://www.vbaexpress.com/forum/showthread.php?t=3628; as it substantiates it's own thread. :)

Quote:

---

Originally Posted by sheeeng

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

Code:

---

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

---

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

Quote:

---

Originally Posted by sheeeng

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

Code:

---

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

Quote:

---

Originally Posted by sheeeng

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

Code:

---

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

---

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

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?

Quote:

---

Originally Posted by Immatoity

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

Code:

---

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

---

and then just sort by the helper column

thats brilliant....cheers