Delete rows based on duplicate data in row G

[Lizard07]

I have a table of data and I want to delete rows where the data is duplicate in row G. Right now I"m using an advanced filter for unique values only

Range("A1:J150").Sort Key1:=Range("I2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("G:G").AdvancedFilter Action:=xlFilterInPlace, Unique:=True

This works, BUT I also need to do a COUNTIF formula based on column I (date column). So I only want it to count the visible rows. Or have the filter delete the duplicates its filtering. The rest of the code is below

Range("A199:A204").Select
Selection.Copy
Range("B199").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("C199").Select
ActiveCell.Formula = "=COUNTIF(I:I,B199)"
Range("C200").Select
ActiveCell.Formula = "=COUNTIF(I:I,B200)"
Range("C201").Select
ActiveCell.Formula = "=COUNTIF(I:I,B201)"
Range("C202").Select
ActiveCell.Formula = "=COUNTIF(I:I,B202)"
Range("C203").Select
ActiveCell.Formula = "=COUNTIF(I:I,B203)"
Range("C204").Select
ActiveCell.Formula = "=COUNTIF(I:I,B204)"

 

[pedie]

If you are trying to remove duplicates in Col G try

[/FONT]
[FONT=Courier New]Sub RemoveDuplicatesinCol_G()
Range("A1").CurrentRegion.RemoveDuplicates Columns:=7, Header:=xlNo
End Sub

 

[Lizard07]

When I run the Macro I receive this error message:

"Object doesn't support this property or method"

Also, will this Macro delete the entire row or just the duplicate cell in G because I need it to delete the entire row.

Thanks

 

[Trevor G]

This deletes the cell contents in the column

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> RemoveDuplicatesinCol_G()<br><SPAN style="color:#007F00">'data must be in all columns</SPAN><br><SPAN style="color:#007F00">'If not then use this G1 first cell being selected and only column 1 as you are in it</SPAN><br><SPAN style="color:#007F00">'It doesn't remove the entire row</SPAN><br>Range("G1").CurrentRegion.RemoveDuplicates 1, xlNo<br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[Lizard07]

Ok, but how would i get it to delete the entire row, not just the cell

 

[Trevor G]

This will delete duplicates and delete the entire row

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> DeleteDups()<br><SPAN style="color:#007F00">'This code will look in column G and delete the entire row</SPAN><br><SPAN style="color:#007F00">'For any duplicates it finds</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>LastRow = Range("g65536").End(xlUp).Row<br>    <SPAN style="color:#00007F">For</SPAN> x = LastRow <SPAN style="color:#00007F">To</SPAN> 1 <SPAN style="color:#00007F">Step</SPAN> -1<br>        <SPAN style="color:#00007F">If</SPAN> Application.WorksheetFunction.CountIf(Range("g1:g" & x), Range("g" & x).Text) > 1 <SPAN style="color:#00007F">Then</SPAN><br>            Range("g" & x).EntireRow.Delete<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> x<br>     <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[Lizard07]

That worked great! Thank-you for your help, this one has been bothering me for the past week

 

[Trevor G]

Pleased to read you have working solution.