Remove duplicate rows

[ADAMC]

Hi all,

Can someone help with me with a macro to remove duplicate rows based on an input in column E?
Heres some sample data below:

Excel Workbook
	A	B	C	D	E	F	G	H
3	Name	Db	Job Number	Addess	Exchange	Required Date	Search Results	Comments
4	blah	blah	blah	blah	MYP35222*	24/08/2011*	blah	blah
5	blah	blah	blah	blah	MYP35222*	24/08/2011*	blah	blah
6	blah	blah	blah	blah	MYP35222*	24/08/2011*	blah	blah
7	blah	blah	blah	blah	MYP35222*	24/08/2011*	blah	blah
8	blah	blah	blah	blah	MYP35222*	24/08/2011*	blah	blah
create_report 1

Basically I need to be left with only 1 row of data where duplicate code appears in column E. In the example above there is a header row which starts in row 3. Iif i run the macro on the sample above i should be left with a header row plus 1 row as the other 4 are duplicates. The start row (row 3) is always the same but the data set can change to a different end row day on day so i need the macro to run until it hits the last row.

Thanks for any help with this.

Edit** the screenshot above shows that the cells contain a * at the end of the reference number i need to remove duplicates in my actual spreadsheet there is no * not sure how this got there.

Thanks

 

[VoG]

Try

Sub NoDup()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
For i = LR To 4 Step -1
    If WorksheetFunction.CountIf(Range("E4:E" & i), Range("E" & i).Value) > 1 Then Rows(i).Delete
Next i
End Sub

 

[cstimart]

Try this...

Sub Delete_Duplicate_Rows( )
Dim i as Long
Dim LR as Long

LR = Range("E" & rows.count).End(xlUp).row

For i = LR to 4 Step -1
   If Range("E" & i) = Range("E" & i - 1) then
        Range("E" & i).EntireRow.Delete
   End If
Next i
End Sub

 

[ADAMC]

Thanks to you both for your replies....both scenarios work....

I tested using VOG's code:

Sub NoDup()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
For i = LR To 4 Step -1
    If WorksheetFunction.CountIf(Range("E4:E" & i), Range("E" & i).Value) > 1 Then Rows(i).Delete
Next i
End Sub

Problem I have is some are merged cells so when I unmerge and run it leaves me with a lot of blank rows....could you please adapt so blank rows are also deleted? If this could be added this would be perfect for what I need

Thank you

 

[VoG]

Try

Sub NoDup()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
For i = LR To 4 Step -1
    If WorksheetFunction.CountIf(Range("E4:E" & i), Range("E" & i).Value) > 1 Then Rows(i).Delete
Next i
On Error Resume Next
Columns("E").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

 

[cstimart]

Thanks to you both for your replies....both scenarios work....

I tested using VOG's code:

Sub NoDup()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
For i = LR To 4 Step -1
    If WorksheetFunction.CountIf(Range("E4:E" & i), Range("E" & i).Value) > 1 Then Rows(i).Delete
Next i
End Sub

Problem I have is some are merged cells so when I unmerge and run it leaves me with a lot of blank rows....could you please adapt so blank rows are also deleted? If this could be added this would be perfect for what I need

Thank you

use the following...

Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

 

[ADAMC]

Works great on my sample data....Really appreciate the response massive time saver for me.

cant thank you both enough!

 

[ADAMC]

Hello all

after such success with my initial post i have found other ways i can improve my spreadsheet just need the help

the macro to remove duplicates works perfectly.....another great help would be if after the duplicate macro is run i could do the following:

Insert a new column at the beginning of the sheet and create a new header row in row 3 titled 'ref'
then for every row:
copy the job number in column C but remove the last 2 numbers
paste this ref into the new column (Column A)
and add the 2 letters from each row of column B to the end of the ref just pasted to column A

So from this:

Excel Workbook
	A	B	C	D	E	F	G	H
3	Cst Name	Db	Job Number	Addess	Exchange	Required Date	Search Results	Comments
4	BLAH	MY*	RMD80708*	BLAH	MYP35222*	BLAH	BLAH	BLAH
5	BLAH	MY*	RMD81708*	BLAH	MYP35222*	BLAH	BLAH	BLAH
6	BLAH	MY*	RMD82808*	BLAH	MYP35222*	BLAH	BLAH	BLAH
7	BLAH	MY*	RMD88006*	BLAH	MYP35222*	BLAH	BLAH	BLAH
8	BLAH	MY*	RMD90008*	BLAH	MYP35222*	BLAH	BLAH	BLAH
create_report 1

To this:

Excel Workbook
	A	B	C	D	E	F	G	H	I
3	REF	Cst Name	Db	Job Number	Addess	Exchange	Required Date	Search Results	Comments
4	RMD807MY	BLAH	MY*	RMD80708*	BLAH	MYP35222*	BLAH	BLAH	BLAH
5	RMD817MY	BLAH	MY*	RMD81708*	BLAH	MYP35222*	BLAH	BLAH	BLAH
6	RMD828MY	BLAH	MY*	RMD82808*	BLAH	MYP35222*	BLAH	BLAH	BLAH
7	RMD880MY	BLAH	MY*	RMD88006*	BLAH	MYP35222*	BLAH	BLAH	BLAH
8	RMD900MY	BLAH	MY*	RMD90008*	BLAH	MYP35222*	BLAH	BLAH	BLAH
create_report 1

I hope this makes sense..........please post back if this isnt clear enough thanks for any help.

 

[VoG]

Untested so try with a copy of your sheet

Sub NoDup()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
For i = LR To 4 Step -1
    If WorksheetFunction.CountIf(Range("E4:E" & i), Range("E" & i).Value) > 1 Then Rows(i).Delete
Next i
On Error Resume Next
Columns("E").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
LR = Range("E" & Rows.Count).End(xlUp).Row
Columns("A").Insert
Range("A3").Value = "Cst Name"
For i = 4 To LR
    Range("A" & i).Value = Left(Range("D" & i).Value, Len(Range("D" & i).Value) - 2)
Next i
End Sub

 

[ADAMC]

Hi VOG

thanks for the reply...this doesnt seem to quite work but as i cant understand your code i cant see what the problem is...heres a before and after....

before:

Excel Workbook
	A	B	C	D	E	F	G	H
3	Cst Name	Db	Job Number	Addess	Exchange	Required Date	Search Results	Comments
4	blah	MY*	RMD80708*	blah	MYP35222*	blah	blah	blah
5	blah	MY*	RMD81708*	blah	MYP35222*	blah	blah	blah
6	blah	MY*	RMD82808*	blah	MYP35222*	blah	blah	blah
7	blah	MY*	RMD88006*	blah	MYP35222*	blah	blah	blah
8	blah	MY*	RMD90008*	blah	MYP35222*	blah	blah	blah
9	blah	MY*	RMX41801*	blah	MYP35222*	blah	blah	blah
create_report 1

AFTER:

Excel Workbook
	A	B	C	D	E	F	G	H	I
3	REF	Cst Name	Db	Job Number	Addess	Exchange	Required Date	Search Results	Comments
4	RMD8070	blah	MY*	RMD80708*	blah	MYP35222*	blah	blah	blah
create_report 1

As you can see it removes all the duplicates correctly but column A should be:
RMD807MY
I cant figure where it gets the 'zero' on the end from.

Thanks