M
mmednick
I have a spreadsheet with 4 collumns: First Name, Last Name, Dept, an
Mailing Address.
There are duplicate rows of peoples names which I need deleted, but al
the steps I have found online only sort on one collumn and assuming I a
sorting by Last Name, they will delete not only extra rows of a specifi
person's name, but also other people (which would be terrible) whom hav
the same last name with a different first name if that makes sense.
The macro I have is:
Public Sub DeleteDuplicateRows()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.
Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Col = ActiveCell.Column
If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) >
Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If
Next r
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Can anyone make a suggestion to change this or a new method of deletin
the extra entries of a person's name?
Thanks for thr advice,
The N00bis
Mailing Address.
There are duplicate rows of peoples names which I need deleted, but al
the steps I have found online only sort on one collumn and assuming I a
sorting by Last Name, they will delete not only extra rows of a specifi
person's name, but also other people (which would be terrible) whom hav
the same last name with a different first name if that makes sense.
The macro I have is:
Public Sub DeleteDuplicateRows()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.
Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Col = ActiveCell.Column
If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) >
Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If
Next r
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Can anyone make a suggestion to change this or a new method of deletin
the extra entries of a person's name?
Thanks for thr advice,
The N00bis