Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 30
Default Delete duplicate rows

Hi,
I have a solution to delete duplicate rows based on the condition of one
cell in a row, but now I have another situation where I have to check if the
entire row is duplicate. I have data from column A thru D. What should I add
to the existing code? Last time Tom Ogilvy helped me with this code. Thanks
in advance.
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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default Delete duplicate rows

How about:

Option Explicit
Sub FixDuplicateRows()
Dim RowNdx As Long
Dim iCol As Long
Dim DeleteThisRow As Boolean
Dim rng As Range

For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1

DeleteThisRow = True
For iCol = 1 To 4 'column A to column D
If Cells(RowNdx, iCol).Value = Cells(RowNdx - 1, iCol).Value Then
'do nothing, keep looking for a difference
Else
DeleteThisRow = False
Exit For
End If
Next iCol

If DeleteThisRow = True Then
If rng Is Nothing Then
Set rng = Cells(RowNdx, 1)
Else
Set rng = Union(rng, Cells(RowNdx, 1))
End If
End If
Next RowNdx
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If
End Sub

Remember that this expects the duplicated rows to be right next to each other.
You'll want to make sure your data is sorted nicely.

Lupe wrote:

Hi,
I have a solution to delete duplicate rows based on the condition of one
cell in a row, but now I have another situation where I have to check if the
entire row is duplicate. I have data from column A thru D. What should I add
to the existing code? Last time Tom Ogilvy helped me with this code. Thanks
in advance.
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


--

Dave Peterson
Reply
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
delete duplicate rows, keep one Wasdell Excel Discussion (Misc queries) 1 October 30th 09 12:16 PM
delete duplicate rows christinaLO Excel Worksheet Functions 1 February 27th 07 06:22 PM
HELP delete duplicate rows. Malcolm Excel Programming 2 September 29th 03 11:48 AM
Delete duplicate rows christina Excel Programming 1 August 4th 03 01:04 PM
delete duplicate rows rhys Excel Programming 2 July 29th 03 12:52 PM


All times are GMT +1. The time now is 11:07 PM.

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

About Us

"It's about Microsoft Excel"