Delete duplicate entries in a column

[robcarr]

Dear All,

I have a spreadsheet that gets data added to it daily, what i need to do is find a username in column B if this is duplicated in the sheet, delete the duplicate row where column A has Main in the cell, (the other duplicate will have a different value in A).

I am not sure if this is able to be done. Any help greatly appreciated.

Thanks Thanks Rob.

 

[Zathras]

Is this a one-time thing? If so, I would just sort and use formulas to find the duplicates. Then paste values and sort again to bring the duplicates together for the kill.

It can be done with VBA, but the requirements are not completely clear:
What if a name appears three or more times? After deleting the row with "Main" you will still have a duplicate and no way to identify which one to delete.

 

[robcarr]

it is an ongoing issue, there will only be 1 duplicate of the username, the dupliacte will always be a different name to the other duplicate. The data gets pasted into the main workbook daily, and then this routine I need to add in, which will remove all unwanted data (as above).



Thanks Rob.

 

[Zathras]

Here is a routine that does what you asked. I'm still not clear on how the "Main" will be re-written on the line that is not deleted. Without re-establishing a row as "Main", the next duplicate won't be deleted.

Option Explicit
Const DELETE_TYPE = "Main"
Const COL_TYPE = 1   ' Column "A"
Const COL_NAMES = 2  ' Column "B"
Const ROW_FIRST = 2
Const ROW_LAST = 65536

Sub DeleteDuplicates()
Dim rng As Range
Dim found As Range
Dim nLastRow As Long
Dim nRow As Long
Dim sName As String
  Set rng = Cells(ROW_LAST, COL_NAMES).End(xlUp)
  nLastRow = rng.Row
  For nRow = nLastRow To (ROW_FIRST + 1) Step -1
    sName = Cells(nRow, COL_NAMES)
    Set rng = Range(Cells(ROW_FIRST, COL_NAMES), Cells(nRow - 1, COL_NAMES))
    Set found = rng.Find(sName)
    If Not found Is Nothing Then
      ' Found a match -- delete the one that says "Main"
      If found.Offset(0, COL_TYPE - COL_NAMES).Text = DELETE_TYPE Then
        found.EntireRow.Delete
      Else
        If Cells(nRow, COL_TYPE).Text = DELETE_TYPE Then
          Cells(nRow, COL_TYPE).EntireRow.Delete
        End If
      End If
    End If
  Next nRow
  Set rng = Nothing
  Set found = Nothing
End Sub