Find duplicate records and delete

[Guest]

Hi,
I have a list with children and the name of the parents. I need to send
letters to the parents but when there is more than one child per parent, the
parent's name appears more than once. I have used Ron de Bruin's code to
replace the duplicate entries with a character. It works just fine, but in
my case I want to delete the duplicate records at once. How can I do this?
Thanks, Lupe

 

[Guest]

show the code that marks the duplicates and someone can modify it to delete.

 

[Guest]

The code is like this:
Sub FixDuplicateRows()
Dim RowNdx As Long
Dim ColNum As Integer
ColNum = Selection(1).Column
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value Then
Cells(RowNdx, ColNum).Value = "----"
End If
Next RowNdx
End Sub

 

[PCLIVE]

I use this code to remove entire rows based on duplicate cells in specific
column. For this to work, the selected information must be sorted on the
column you want to search for duplicates. The code does this for you.
Where it states "Range("A1:A15000").Select", you should adjust this range to
match your data. So if your row spans from column A to D and you want it to
go down 1000 rows, then adjust it to "Range("A11000").Select". The the
next line you'll need to set the column of which you will be sorting ( I'm
assuming this will be the Parents Name column. If that were column C, then
you would change the Sort Key1:= to "Range("C1"). You would also change it
at the bottom of the code as well. You should make a back-up of your
workbook and then test this code. Hope this helps.
Paul

Sub RemoveDuplicates
Range("A1:A15000").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ColNum = Selection(1).Column
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value Then
Cells(RowNdx, ColNum).Value = ""

End If

Next RowNdx

Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

End Sub

 

[PCLIVE]

Oops. My post didn't remove the entire record or row. Assuming you want to
remove the entire row, you could change
from:
Cells(RowNdx, ColNum).Value = "----"

To:
Cells(RowNdx, ColNum).EntireRow.Delete

 

[Guest]

Sub FixDuplicateRows()
Dim RowNdx As Long
Dim ColNum As Integer
Dim rng as Range
ColNum = Selection(1).Column
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value Then
if rng is nothing then
set rng = Cells(RowNdx,ColNum)
else
set rng = Union(rng,cells(RowNdx,ColNum)
end if
End If
Next RowNdx
if not rng is nothing then
rng.entirerow.Delete
End if
End Sub

 

[Guest]

Tom,
Works like a charm. Thank you so much!
Lupe

Sub FixDuplicateRows()
Dim RowNdx As Long
Dim ColNum As Integer
Dim rng as Range
ColNum = Selection(1).Column
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value Then
if rng is nothing then
set rng = Cells(RowNdx,ColNum)
else
set rng = Union(rng,cells(RowNdx,ColNum)
end if
End If
Next RowNdx
if not rng is nothing then
rng.entirerow.Delete
End if
End Sub