Modify VBA code to remove all duplicates apart from first 2 rows - excel

Question

I have found the following code which does a good job for me at extracting the data I need but I now need to modify it. Currently it removes all duplicate rows based on active column and keeps the first row.
I need to run it on a different column and remove all duplicates apart from the first 2 rows this time.
I don't know how to change it.
Many thanks
Public 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

Answer 1

To preserve the first 2 rows change the For Loop from
For R = Rng.Rows.Count To 2 Step -1
to:
For R = Rng.Rows.Count To 3 Step -1
To work on a different column to ActiveColumn change this line
Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
ActiveSheet.Columns(ActiveCell.Column))
To something like:
Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
ActiveSheet.Range("A1").EntireColumn))
(Where column A is the column to be used)