LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3
Default Eliminate Duplicates

I discovered this on a website - It will work whether the data is
sorted to get duplicates together or not and is only suitable if you
want to delete a entire row of data


Public Sub DeleteDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That
is,
' if the same value is found more than once in the Active Column, all
but
' the first (lowest row number) will be deleted.
'
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''

Dim R As Long
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
ActiveSheet.Columns(ActiveCell.Column))

Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")

N = 0
For R = Rng.Rows.Count To 2 Step -1
If R Mod 500 = 0 Then
Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
End If

V = Rng.Cells(R, 1).Value
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''
' Note that COUNTIF works oddly with a Variant that is equal to
vbNullString.
' Rather than pass in the variant, you need to pass in vbNullString
explicitly.
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''
If V = vbNullString Then
If Application.WorksheetFunction.CountIf(Rng.Columns( 1),
vbNullString) 1 Then
Rng.Rows(R).EntireRow.Delete
N = N + 1
End If
Else
If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) 1
Then
Rng.Rows(R).EntireRow.Delete
N = N + 1
End If
End If
Next R

EndMacro:

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate Rows Deleted: " & CStr(N)

End Sub

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
eliminate duplicates on a sheet C. Brown Excel Worksheet Functions 3 April 5th 10 03:54 AM
How to eliminate everything but duplicates jtpryan Excel Worksheet Functions 2 February 17th 09 04:32 PM
Eliminate duplicates in mailing list AnneCir Excel Discussion (Misc queries) 7 April 4th 07 11:58 PM
Eliminate Duplicates in Pivot Table roadkill Excel Discussion (Misc queries) 2 February 3rd 06 06:13 PM
Ecxel Macro to summary and eliminate duplicates kdreyer Excel Programming 2 February 4th 05 10:19 PM


All times are GMT +1. The time now is 08:22 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"