VBA Clear Duplicates

[bored622]

Hello everyone,

I am trying to create a formula that clears the fourth duplicate by removing the whole row using "clear contents." So far, my formula grabs all the unique data points from one column and pastes them into another column. Finally, it filters the entire worksheet using the first forty-one unique data points that were moved into the other column. So for the last step of my formula, I need it to clear any rows that have a fourth duplicate in column C. Below is the formula I use for what I just explained. If this is not possible, could the cell with the fourth duplicate be cleared using "clear contents"?

Sub Get_Unique_Values1()
Dim row As Long
row = Cells(Rows.Count, "C").End(xlUp).row
ActiveSheet.Range("C7:C" & row).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("X7"), _
Unique:=True
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Range("C7:C80").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("X7:X47"), Unique:=False
End Sub

 

[bored622]

Hello everyone,

I am trying to create a formula that clears the fourth duplicate by removing the whole row using "clear contents." So far, my formula grabs all the unique data points from one column and pastes them into another column. Finally, it filters the entire worksheet using the first forty-one unique data points that were moved into the other column. So for the last step of my formula, I need it to clear any rows that have a fourth duplicate in column C. Below is the formula I use for what I just explained. If this is not possible, could the cell with the fourth duplicate be cleared using "clear contents"?

Sub Get_Unique_Values1()
Dim row As Long
row = Cells(Rows.Count, "C").End(xlUp).row
ActiveSheet.Range("C7:C" & row).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("X7"), _
Unique:=True
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Range("C7:C80").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("X7:X47"), Unique:=False
End Sub

I just wanted to update the problem. I managed to make the code so it highlights the fourth duplicate in the column, but what can I add to the end of my formula so that it hides rows with a highlighted cell or clears them using "clear contents"?

Current formula

Sub Get_Unique_Values1()
'Grabs all duplicates from column C
'Pastes the duplicates in column X
'Advance Filters file by the first 41 DPCIs in column X
Dim row As Long
row = Cells(Rows.Count, "C").End(xlUp).row
ActiveSheet.Range("C7:C" & row).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("X7"), _
Unique:=True
Application.CutCopyMode = False
Range("C7:C500").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("X7:X47"), Unique:=False
'colors every fourth duplicate
Range("C7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=COUNTIF($C$7:$C7,$C7)>=4"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
End Sub