Delete second duplicate rows

Panoos64 · Nov 14, 2017

Hi all, i would like to write a vba so that to delete the second duplicate entire rows as my below extracts. In sch. 2. are the original data and on sch. 2. is the expected result.

Thanking you in advance

Sch.1.

7800005 ΙNDIVIDUALS

7800022-BUISINESS

7800027-TOUR OPERATORS

7800035-CONFERENCES

7800068-FUNCTIONS

<colgroup><col style="mso-width-source:userset;mso-width-alt:804;width:17pt" width="22"> <col style="mso-width-source:userset;mso-width-alt:5778;width:119pt" width="158"> <col style="mso-width-source:userset;mso-width-alt:2084; width:43pt" width="57" span="2"> </colgroup><tbody>
[TD="width: 22, align: center"][/TD]
[TD="width: 158, align: center"]A[/TD]
[TD="width: 57, align: center"]C[/TD]
[TD="width: 57, align: center"]D[/TD]

[TD="align: center"]1[/TD]
[TD="class: xl65"]31-12-17
[/TD]
[TD="class: xl66, align: center"]January[/TD]
[TD="class: xl66, align: center"]February[/TD]

[TD="align: center"]2[/TD]

[TD="class: xl66, align: center"]7,800[/TD]
[TD="class: xl66, align: center"]6,500[/TD]

[TD="align: center"]3[/TD]

[TD="class: xl66, align: center"] [/TD]
[TD="class: xl66, align: center"] [/TD]

[TD="align: center"]4[/TD]

[TD="class: xl66, align: center"][/TD]
[TD="class: xl66, align: center"][/TD]

[TD="align: center"]5[/TD]

[TD="class: xl66, align: center"]3,282[/TD]
[TD="class: xl66, align: center"]2,155
[/TD]

[TD="align: center"]6[/TD]
[TD="colspan: 2"]7800027-TOUR OPERATORS[/TD]
[TD="class: xl66, align: center"][/TD]

[TD="align: center"]7[/TD]

[TD="class: xl66, align: center"]5,478[/TD]
[TD="class: xl66, align: center"]4,578[/TD]

[TD="align: center"]8[/TD]

[TD="class: xl66, align: center"][/TD]
[TD="class: xl66, align: center"][/TD]

[TD="align: center"]9[/TD]

[TD="class: xl66, align: center"] [/TD]
[TD="class: xl66, align: center"]1,258
[/TD]

[TD="align: center"]10[/TD]

[TD="class: xl66, align: center"][/TD]
[TD="class: xl66, align: center"][/TD]

</tbody>

Sch.2.

7800005 ΙNDIVIDUALS

<colgroup><col style="mso-width-source:userset;mso-width-alt:804;width:17pt" width="22"> <col style="mso-width-source:userset;mso-width-alt:5778;width:119pt" width="158"> <col style="mso-width-source:userset;mso-width-alt:2084; width:43pt" width="57" span="2"> </colgroup><tbody>
[TD="width: 22, align: center"][/TD]
[TD="width: 158, align: center"]A[/TD]
[TD="width: 57, align: center"]C[/TD]
[TD="width: 57, align: center"]D[/TD]

[TD="align: center"]1[/TD]
[TD="class: xl65, align: center"]31-12-17
[/TD]
[TD="class: xl66, align: center"]January[/TD]
[TD="class: xl66, align: center"]February
[/TD]

[TD="align: center"]2[/TD]

[TD="class: xl66, align: center"]7,800[/TD]
[TD="class: xl66, align: center"]6,500
[/TD]

[TD="align: center"]3[/TD]
[TD="align: center"]7800022-BUISINESS[/TD]
[TD="class: xl66, align: center"] [/TD]
[TD="class: xl66, align: center"] [/TD]

[TD="align: center"]4[/TD]
[TD="align: center"]7800027-TOUR OPERATORS
[/TD]
[TD="class: xl66, align: center"]3,282[/TD]
[TD="class: xl66, align: center"]2,155
[/TD]

[TD="align: center"]5[/TD]
[TD="align: center"]7800035-CONFERENCES[/TD]
[TD="class: xl66, align: center"]5,478[/TD]
[TD="class: xl66, align: center"]4,578[/TD]

[TD="align: center"]6[/TD]
[TD="align: center"]7800068-FUNCTIONS
[/TD]
[TD="class: xl66, align: center"] [/TD]
[TD="class: xl66, align: center"]1,258[/TD]

</tbody>

alansidman · Nov 14, 2017

Code:

Option Explicit


Sub DeleteDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That is,
' if the same value is found more than once in the Active Column, all but
' the first (lowest row number) will be deleted.
'
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


    Dim r As Long
    Dim n As Long
    Dim V As Variant
    Dim rng As Range


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




    Set rng = Application.Intersect(ActiveSheet.UsedRange, _
                                    ActiveSheet.Columns(ActiveCell.Column))


    Application.StatusBar = "Processing Row: " & Format(rng.Row, "#,##0")


    n = 0
    For r = rng.Rows.Count To 2 Step -1
        If r Mod 500 = 0 Then
            Application.StatusBar = "Processing Row: " & Format(r, "#,##0")
        End If


        V = rng.Cells(r, 1).Value
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
        ' Rather than pass in the variant, you need to pass in vbNullString explicitly.
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If V = vbNullString Then
            If Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Then
                rng.Rows(r).EntireRow.Delete
                n = n + 1
            End If
        Else
            If Application.WorksheetFunction.CountIf(rng.Columns(1), V) > 1 Then
                rng.Rows(r).EntireRow.Delete
                n = n + 1
            End If
        End If
    Next r


EndMacro:


    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Duplicate Rows Deleted: " & CStr(n)




End Sub

Panoos64 · Nov 14, 2017

Thank you so much alan! It works perfect and nicely. In addition thanks also for your time spent for me. Have a great day!

oldbrewer · Nov 14, 2017

[TABLE="width: 1130"]
<colgroup><col><col><col span="4"><col><col><col span="2"></colgroup><tbody>[TR]
[TD]31/12/2017[/TD]
[TD]January[/TD]
[TD]February[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7800005 INDIVIDUALS[/TD]
[TD]7,800[/TD]
[TD]6,500[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7800022-BUISINESS[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7800027-TOUR OPERATORS[/TD]
[TD]3,282[/TD]
[TD]2,155[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7800035-CONFERENCES[/TD]
[TD]5,478[/TD]
[TD]4,578[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7800068-FUNCTIONS[/TD]
[TD][/TD]
[TD]1,258[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]original data[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]31/12/2017[/TD]
[TD]January[/TD]
[TD]February[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="colspan: 2"]this macro removed the duplicate rows[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]7800005 INDIVIDUALS[/TD]
[TD]7,800[/TD]
[TD]6,500[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]7800022-BUISINESS[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Sub Macro4()[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]7800022-BUISINESS[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]'[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]7800027-TOUR OPERATORS[/TD]
[TD]3,282[/TD]
[TD]2,155[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]' Macro4 Macro[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]7800027-TOUR OPERATORS[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="colspan: 2"]' Macro recorded 14/11/2017 by bob[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]7800035-CONFERENCES[/TD]
[TD]5,478[/TD]
[TD]4,578[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]'[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]7800068-FUNCTIONS[/TD]
[TD][/TD]
[TD]1,258[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]7800068-FUNCTIONS[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]'[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]10 For j = 2 To 100[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="colspan: 2"] If Cells(j, 1) = "" Then GoTo 999[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="colspan: 4"] If Cells(j, 1) = Cells(j + 1, 1) Then GoTo 20 Else GoTo 40[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]20 Rows(j + 1).Select[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="colspan: 2"] Selection.Delete Shift:=xlUp[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD] GoTo 10[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]40 Next j[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]999 End Sub[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Panoos64 · Nov 14, 2017

Hi oldb, the code works perfect and is a simple one! Thank you so much for your support to resolve the issue for my project. Have a nice day!

oldbrewer · Nov 14, 2017

72 years old to be precise - have to exercise the brain every day... you are welcome....

Marcelo Branco · Nov 14, 2017

Just for the records. There is an easy method to delete duplicate rows in a range keeping the first one.

Select the range
Home > Format as Table
in Tables Tools click in Delete Duplicates; uncheck January and February
Ok

Done!

Right-click in any cell inside the table; click in Table and convert to range (if desired)

M.

Panoos64 · Nov 15, 2017

Hi Marcelo, I tested your above suggestion and is right and also very simple too. My query is how you determine to delete specific second row and not the first ? Just I am asking to improve my knowledge in excel. Have a great day

Marcelo Branco · Nov 15, 2017

Panoos64 said:
Hi Marcelo, I tested your above suggestion and is right and also very simple too. My query is how you determine to delete specific second row and not the first ? Just I am asking to improve my knowledge in excel. Have a great day

To determine if it is the first instance, in a column with duplicates, we can use COUNTIF with a progressive range.

Example

[TABLE="class: grid"]
<tbody>[TR]
[TD="bgcolor: #DCE6F1"][/TD]
[TD="bgcolor: #DCE6F1"]

A

[/TD]
[TD="bgcolor: #DCE6F1"]

B