Remove Duplicates Leaves the wrong data I need last row not first?

[tonywatsonhelp]

HI Everyone,

I have this Macro that removes duplicates great

Sub Macro2()
    ActiveSheet.Unprotect
    ActiveSheet.Range("$A:$N").RemoveDuplicates Columns:=Array(2, 9, 10), _
        Header:=xlYes
       ActiveSheet.Protect
End Sub

The only problem is it leaves the first row not the last row of data

can I get it to leave the last row?

thanks

Tony

 

[tonywatsonhelp]

Sorry Footoo, I just reads that back and it sounded a lot ruder then it did in my head, I didn't mean to sound ungreatful as your idea would be perfect normally.

My document is old and has all sort of links and formulas and I worried if I Sort the data thensort it back it wont work properly as there are as fixed values that use things like "Indirect" so if I move them the Indirect is going to be looking at the wrong data,
however I will test it and see if there is a way I could use it maybe making some change to the rest of the document.

Thanks

Tony

 

[Oeldere]

(P.S. I feel this is going off track! so please only reply if you have a solution or something I will find helpful as I have to keep restarting my PC)

As I am not sure my solution is the solution you will like, I won't post it.

 

[Peter_SSs]

You could try this on a copy of your workbook. It also does use a helper column, but only temporarily. It does not use Remove Duplicates, but I think does what you want without re-ordering the data.

Sub LeaveLastDupe()
  Dim d As Object
  Dim a As Variant, b As Variant, aRws As Variant
  Dim rng As Range
  Dim lr As Long, lCalc As Long, nc As Long, i As Long, k As Long
  Dim s As String
  
  Set d = CreateObject("Scripting.Dictionary")
  d.comparemode = 1
  nc = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  With Columns("A:N")
    lr = .Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set rng = .Resize(lr)
  End With
  aRws = Evaluate("row(1:" & lr & ")")
  a = Application.Index(rng, aRws, Array(2, 9, 10))
  ReDim b(1 To lr, 1 To 1)
  For i = lr To 2 Step -1
    s = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)
    If d.exists(s) Then
      b(i, 1) = 1
      k = k + 1
    Else
      d(s) = Empty
    End If
  Next i
  If k > 0 Then
    With Application
      .ScreenUpdating = False
      lCalc = .Calculation
      .Calculation = xlCalculationManual
    End With
    ActiveSheet.Unprotect
    Cells(1, nc).Resize(lr).Value = b
    Intersect(Cells(1, nc).Resize(lr).SpecialCells(xlConstants, xlNumbers).EntireRow, rng).Delete Shift:=xlUp
    Cells(1, nc).Resize(lr).ClearContents
    ActiveSheet.Protect
    With Application
      .ScreenUpdating = True
      .Calculation = lCalc
    End With
  End If
End Sub