Delete rows based on a specific Column

[jxj_00]

Hi

I have a database that needs to be regularly updated and to prevent any duplication of records the codes need to do the following:
1. To delete the entire row if any duplicates in Column A (Employee ID)
2. To duplicate the first entry (Meaning if there was a duplicate of row 1 with row 15 it will delete row 1)

I have attach a copy of the excel in this link: Box

Sub RemoveDuplicateRows()

Dim MyRange As Range
Dim LastRow As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Set MyRange = ActiveSheet.Range("A1:D" & LastRow)
MyRange.RemoveDuplicates Columns:=1, Header:=xlYes

End Sub

 

[Fluff]

How about

Sub jxj()
   Dim i As Long
   Dim Rng As Range
   
   With CreateObject("scripting.dictionary")
      For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
         If Not .Exists(Cells(i, 1).Value) Then
            .Add Cells(i, 1).Value, Nothing
         Else
            If Rng Is Nothing Then Set Rng = Cells(i, 1) Else Set Rng = Union(Rng, Cells(i, 1))
         End If
      Next i
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub

 

[jxj_00]

How about

Sub jxj()
   Dim i As Long
   Dim Rng As Range
  
   With CreateObject("scripting.dictionary")
      For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
         If Not .Exists(Cells(i, 1).Value) Then
            .Add Cells(i, 1).Value, Nothing
         Else
            If Rng Is Nothing Then Set Rng = Cells(i, 1) Else Set Rng = Union(Rng, Cells(i, 1))
         End If
      Next i
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub

The code works! Thank you for your help!

 

[jxj_00]

How about

Sub jxj()
   Dim i As Long
   Dim Rng As Range
  
   With CreateObject("scripting.dictionary")
      For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
         If Not .Exists(Cells(i, 1).Value) Then
            .Add Cells(i, 1).Value, Nothing
         Else
            If Rng Is Nothing Then Set Rng = Cells(i, 1) Else Set Rng = Union(Rng, Cells(i, 1))
         End If
      Next i
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub

The 1st few times the code works but suddenly it showed an error message. Any idea on how to solve it?
It highlighted the If Not Rng Is Nothing Then Rng.EntireRow.Delete

 

[Fluff]

Is the sheet protected & do you have any merged cells?

 

[jxj_00]

Is the sheet protected & do you have any merged cells?

I think I had accidentally left some cells merged. I have unmerged them and the code has started running again, thanks for your help!

 

[Fluff]

You're welcome & thanks for the feedback.

 

[jxj_00]

Hi

The code sometimes work sometimes doesn't work.

It highlights this portion of the code. May I know if there is an alternative code for this?

  If Not Rng Is Nothing Then Rng.EntireRow.Delete

 

[Fluff]

What error do you get?

 

[jxj_00]

I got an error for 1004 Delete method of Range class failed