Advanced Filter with duplicate deletions

[sheeeng]

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..?
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.

[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.

[Zack Barresse]

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

[Bob Phillips]

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]

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]

Hi johnske & all,

How can I delete duplicate row with these code..?
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.

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]

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]

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]

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]

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]

thats brilliant....cheers