Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
delete duplicate rows, keep one | Excel Discussion (Misc queries) | |||
delete duplicate rows | Excel Worksheet Functions | |||
HELP delete duplicate rows. | Excel Programming | |||
Delete duplicate rows | Excel Programming | |||
delete duplicate rows | Excel Programming |