Remove duplicate rows

[tbasic]

I am trying to write a macro that would remove duplicate rows in a worksheet. The worksheet consists of Columns A-M. There are 200 rows. I would like to search column B for any duplicates and remove the duplicates completely. I used the following code from an earlier post, but it just seems to do the search on column A. I am also trying to have any data that is below row 200 to remain in the same cell even though some of the rows in the search are being deleted

Public Sub DeleteDuplicateRows(

' This macro deletes duplicate rows in the selection. Duplicates ar
' counted in the COLUMN of the active cell

Dim Col As Intege
Dim r As Lon
Dim C As Rang
Dim N As Lon
Dim V As Varian
Dim Rng As Rang

On Error GoTo EndMacr
Application.ScreenUpdating = Fals
Application.Calculation = xlCalculationManua

Col = ActiveCell.Colum

If Selection.Rows.Count > 1 The
Set Rng = Selectio
Els
Set Rng = ActiveSheet.UsedRange.Row
End I

N =
For r = Rng.Rows.Count To 1 Step -
V = Rng.Cells(r, 1).Valu
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 The
Rng.Rows(r).EntireRow.Delet
N = N +
End I
Next

EndMacro

Application.ScreenUpdating = Tru
Application.Calculation = xlCalculationAutomati

End Su

 

[Frank Kabel]

Hi
I already posted a possible solution for this in yur earlier thread. A
repost:

------
try the following macro (borrowed from
http://www.cpearson.com/excel/deleting.htm#DeleteDuplicateRows):
Public Sub DeleteDuplicateRows()

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

Set Rng = ActiveSheet.Range("B1:B199")


N = 0
For r = 199 To 1 Step -1
V = Rng.Cells(r, 2).Value
If Application.WorksheetFunction.CountIf(Rng,V) > 1 Then
Rng.Rows(r).EntireRow.ClearContents
N = N + 1
End If
Next r

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub


After this select the rows 1:199 and sort them so that you move the
blank lines down