ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   delete rows that have a duplicate id keeping the upper row (https://www.excelbanter.com/excel-programming/440745-delete-rows-have-duplicate-id-keeping-upper-row.html)

Bruce Walker

delete rows that have a duplicate id keeping the upper row
 
I neeed a macro that will delte a row based on a duplicate value in column A;
Row col A col B col C
Claim Number DCC Warranty Code
1 0132482B DTYC 03D
2 0137448A 1
3 0141614A 01D
4 0141614A
5 0141614A
6 0143504B 1
7 0154120A DW77 01D
8 0154120A
9 0159953A DWL0 03D
In this example I want to delete rows 4,5, and 8 How might this be
accomlpished? Thanks.
Bruce

Chip Pearson

delete rows that have a duplicate id keeping the upper row
 
Try code like

Sub AAA()
Dim LastRow As Long
Dim RowNdx As Long
Dim N As Long

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For RowNdx = LastRow To 2 Step -1
N = Application.CountIf( _
Range(Cells(2, "A"), Cells(RowNdx, "A")), _
Cells(RowNdx, "A"))
If N 1 Then
Rows(RowNdx).Delete
End If
Next RowNdx
End Sub

Cordially,
Chip Pearson
Microsoft Most Valuable Professional,
Excel, 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com



On Wed, 17 Mar 2010 12:57:01 -0700, Bruce Walker <Bruce
wrote:

I neeed a macro that will delte a row based on a duplicate value in column A;
Row col A col B col C
Claim Number DCC Warranty Code
1 0132482B DTYC 03D
2 0137448A 1
3 0141614A 01D
4 0141614A
5 0141614A
6 0143504B 1
7 0154120A DW77 01D
8 0154120A
9 0159953A DWL0 03D
In this example I want to delete rows 4,5, and 8 How might this be
accomlpished? Thanks.
Bruce


JLGWhiz[_2_]

delete rows that have a duplicate id keeping the upper row
 
Sub DelDupRow() 'if duplicates exists, deletes duplicate rows
Dim lr As Long, sh As Worksheet
Set sh = ActiveSheet
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row .
For i = lr To 2 Step -1
With sh
If Cells(i, 1).Value = Cells(i-1, 1).Value Then
Rows(i).Delete
End If
End With
Next
End Sub






"Bruce Walker" <Bruce wrote in message
...
I neeed a macro that will delte a row based on a duplicate value in column
A;
Row col A col B col C
Claim Number DCC Warranty Code
1 0132482B DTYC 03D
2 0137448A 1
3 0141614A 01D
4 0141614A
5 0141614A
6 0143504B 1
7 0154120A DW77 01D
8 0154120A
9 0159953A DWL0 03D
In this example I want to delete rows 4,5, and 8 How might this be
accomlpished? Thanks.
Bruce




Mike H

delete rows that have a duplicate id keeping the upper row
 
Hi,

Ensure your data sheet is the active sheet and try this

Sub delete_Me2()
Dim CopyRange As Range
Dim X as Long, LastRow as long
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
If WorksheetFunction.CountIf(Range(Cells(x, 1), _
Cells(x + 1, LastRow)), Cells(x, 1)) 1 Then
If CopyRange Is Nothing Then
Set CopyRange = Rows(x).EntireRow
Else
Set CopyRange = Union(CopyRange, Rows(x).EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
CopyRange.Delete
End If
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Bruce Walker" wrote:

I neeed a macro that will delte a row based on a duplicate value in column A;
Row col A col B col C
Claim Number DCC Warranty Code
1 0132482B DTYC 03D
2 0137448A 1
3 0141614A 01D
4 0141614A
5 0141614A
6 0143504B 1
7 0154120A DW77 01D
8 0154120A
9 0159953A DWL0 03D
In this example I want to delete rows 4,5, and 8 How might this be
accomlpished? Thanks.
Bruce


Mike H

delete rows that have a duplicate id keeping the upper row
 
Ignore this, I missed keep the upper row bit
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Mike H" wrote:

Hi,

Ensure your data sheet is the active sheet and try this

Sub delete_Me2()
Dim CopyRange As Range
Dim X as Long, LastRow as long
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
If WorksheetFunction.CountIf(Range(Cells(x, 1), _
Cells(x + 1, LastRow)), Cells(x, 1)) 1 Then
If CopyRange Is Nothing Then
Set CopyRange = Rows(x).EntireRow
Else
Set CopyRange = Union(CopyRange, Rows(x).EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
CopyRange.Delete
End If
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Bruce Walker" wrote:

I neeed a macro that will delte a row based on a duplicate value in column A;
Row col A col B col C
Claim Number DCC Warranty Code
1 0132482B DTYC 03D
2 0137448A 1
3 0141614A 01D
4 0141614A
5 0141614A
6 0143504B 1
7 0154120A DW77 01D
8 0154120A
9 0159953A DWL0 03D
In this example I want to delete rows 4,5, and 8 How might this be
accomlpished? Thanks.
Bruce


Mike H

delete rows that have a duplicate id keeping the upper row
 
That's got it

Sub delete_Me2()
Dim CopyRange As Range
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For x = LastRow To 2 Step -1
Range(Cells(1, 1), Cells(x - 1, 1)).Select
If WorksheetFunction.CountIf(Range(Cells(1, 1), _
Cells(x - 1, 1)), Cells(x, 1)) 0 Then
Rows(x).Delete
End If
Next
If Not CopyRange Is Nothing Then
CopyRange.Select
End If
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Mike H" wrote:

Ignore this, I missed keep the upper row bit
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Mike H" wrote:

Hi,

Ensure your data sheet is the active sheet and try this

Sub delete_Me2()
Dim CopyRange As Range
Dim X as Long, LastRow as long
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
If WorksheetFunction.CountIf(Range(Cells(x, 1), _
Cells(x + 1, LastRow)), Cells(x, 1)) 1 Then
If CopyRange Is Nothing Then
Set CopyRange = Rows(x).EntireRow
Else
Set CopyRange = Union(CopyRange, Rows(x).EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
CopyRange.Delete
End If
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Bruce Walker" wrote:

I neeed a macro that will delte a row based on a duplicate value in column A;
Row col A col B col C
Claim Number DCC Warranty Code
1 0132482B DTYC 03D
2 0137448A 1
3 0141614A 01D
4 0141614A
5 0141614A
6 0143504B 1
7 0154120A DW77 01D
8 0154120A
9 0159953A DWL0 03D
In this example I want to delete rows 4,5, and 8 How might this be
accomlpished? Thanks.
Bruce


Bruce Walker[_2_]

delete rows that have a duplicate id keeping the upper row
 
Mike,
Thank you very much (and to all that replied)! It does exactly what I needed
it to do. I have a similar but somewhat more complicated spreadsheet I need a
macro for the same thing, but I am not sure how to explain it without you
being able to see it. Any suggestions? Thanks again.

"Mike H" wrote:

That's got it

Sub delete_Me2()
Dim CopyRange As Range
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For x = LastRow To 2 Step -1
Range(Cells(1, 1), Cells(x - 1, 1)).Select
If WorksheetFunction.CountIf(Range(Cells(1, 1), _
Cells(x - 1, 1)), Cells(x, 1)) 0 Then
Rows(x).Delete
End If
Next
If Not CopyRange Is Nothing Then
CopyRange.Select
End If
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Mike H" wrote:

Ignore this, I missed keep the upper row bit
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Mike H" wrote:

Hi,

Ensure your data sheet is the active sheet and try this

Sub delete_Me2()
Dim CopyRange As Range
Dim X as Long, LastRow as long
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
If WorksheetFunction.CountIf(Range(Cells(x, 1), _
Cells(x + 1, LastRow)), Cells(x, 1)) 1 Then
If CopyRange Is Nothing Then
Set CopyRange = Rows(x).EntireRow
Else
Set CopyRange = Union(CopyRange, Rows(x).EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
CopyRange.Delete
End If
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Bruce Walker" wrote:

I neeed a macro that will delte a row based on a duplicate value in column A;
Row col A col B col C
Claim Number DCC Warranty Code
1 0132482B DTYC 03D
2 0137448A 1
3 0141614A 01D
4 0141614A
5 0141614A
6 0143504B 1
7 0154120A DW77 01D
8 0154120A
9 0159953A DWL0 03D
In this example I want to delete rows 4,5, and 8 How might this be
accomlpished? Thanks.
Bruce



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

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com