Macro to find where rows start to repeat then delete all rows below

[waterkris]

Good Day,

I have a spreadsheet which contains names in column A sorted alphabetically. And after a certain row the names start to repeat. I'm trying to write a macro which finds the row where the names start to repeat, then deletes that row and all subsequent rows below. Can anyone help?

 

[JoeMo]

Not clear to me how names sorted alphabetically wouldn't have the repeaters grouped together. Can you post some sample data showing exactly how it looks before the macro you want is executed, and how that data will look after the macro is executed?

 

[Rick Rothstein]

I have a spreadsheet which contains names in column A sorted alphabetically. And after a certain row the names start to repeat. I'm trying to write a macro which finds the row where the names start to repeat, then deletes that row and all subsequent rows below.

Does this macro do what you want...

Sub DeleteDupes()
  Columns("A").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

 

[LloydFinancials]

Is the first record always the record that repeats first?

 

[waterkris]

Good Day All,

Thank you for the suggestions. I apologize for not being very clear on describing the situation.
I'm using a software containing database of crew members of a passenger ship. There is a function to export the crew list to Excel. The names are already sorted alphabetically, but the crew list repeats itself several times. The names are usually around 1200. My wish is after exporting to Excel to run a macro which will find the duplicate names in column A and delete the entire corresponding row. The spread sheet contains about 15-20 columns.

 

[Rick Rothstein]

See if this macro does what you want...

[table="width: 500"]
[tr]
	[td]Sub RemoveDuplicatesAndAssociatedRows()
  Dim LastRow As Long, UnusedCol As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  UnusedCol = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious, , , False).Column + 1
  With Range(Cells(1, UnusedCol), Cells(LastRow, UnusedCol))
    .Formula = "=COUNTIF(A$1:A1,A1)"
    .Value = Evaluate(Replace("IF(@>1,@,"""")", "@", .Address))
    On Error GoTo NoDupes
    .SpecialCells(xlConstants).EntireRow.Delete
  End With
NoDupes:
End Sub[/td]
[/tr]
[/table]

 

[waterkris]

Hi Rick,

I tried your code but it deleted everything, all cells.

In fact, now I'm thinking about a different approach. My ultimate goal is to copy the rows which would remain after deleting the duplicate ones. So, what if the macro looks for the first row where the names in column A start to repeat and then copies all rows above this row (except row 1) from column A to F.

.

See if this macro does what you want...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub RemoveDuplicatesAndAssociatedRows()
  Dim LastRow As Long, UnusedCol As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  UnusedCol = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious, , , False).Column + 1
  With Range(Cells(1, UnusedCol), Cells(LastRow, UnusedCol))
    .Formula = "=COUNTIF(A$1:A1,A1)"
    .Value = Evaluate(Replace("IF(@>1,@,"""")", "@", .Address))
    On Error GoTo NoDupes
    .SpecialCells(xlConstants).EntireRow.Delete
  End With
NoDupes:
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

 

[Fluff]

Maybe

Sub CopyUnique()
   Dim Cl As Range, Rng As Range
   
   With CreateObject("scripting.dictionary")
      Set Rng = Range("A2")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Nothing
            Set Rng = Union(Rng, Cl)
         End If
      Next Cl
   End With
   Rng.EntireRow.Copy Sheets("Sheet2").Range("A2")
End Sub