Delete second duplicate rows

[Panoos64]

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.

	A	C	D
1	31-12-17	January	February
2	7800005 ΙNDIVIDUALS	7,800	6,500
3	7800022-BUISINESS
4	7800022-BUISINESS
5	7800027-TOUR OPERATORS	3,282	2,155
6	7800027-TOUR OPERATORS
7	7800035-CONFERENCES	5,478	4,578
8	7800035-CONFERENCES
9	7800068-FUNCTIONS		1,258
10	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>
</tbody>

Sch.2.

	A	C	D
1	31-12-17	January	February
2	7800005 ΙNDIVIDUALS	7,800	6,500
3	7800022-BUISINESS
4	7800027-TOUR OPERATORS	3,282	2,155
5	7800035-CONFERENCES	5,478	4,578
6	7800068-FUNCTIONS		1,258

<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>
</tbody>

 

[alansidman]

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]

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]

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

<colgroup><col><col><col span="4"><col><col><col span="2"></colgroup><tbody>
</tbody>

 

[Panoos64]

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]

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

 

[Marcelo Branco]

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]

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]

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

	A​	B​
1​	Name​	First instance?​
2​	Anthony​	Yes​
3​	Mary​	Yes​
4​	John​	Yes​
5​	Mary​	No​
6​	Richard​	Yes​
7​	Richard​	No​
8​	Robert​	Yes​
9​	Mary​	No​
10​	Charles​	Yes​
11​	Mary​	No​

<tbody>
</tbody>

Formula in B2 copied down
=IF(COUNTIF(A$2:A2,A2)=1,"Yes","No")

Note that the range A$2:A2 in the first cell (B2), in the second cell (B3) becomes A$2:A3, in the third A$2:A4, and so on.

M.

 

[Panoos64]

Many thanks Marcelo for the above explanation, but regarding your below commands which for me is right and it works for my project, how you determine to delete the 2nd row of the duplicates? Just i would like to learn! Thanks!


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)