Delete Duplicates if value of the cells Count exceeds 3 times

[tobysimon]

Hello Experts,

Am trying VBA for below execution but it seems to delete the entire data.

Column "R" has duplicates, where each cell value has more than 3 duplicates in the column and some are not. How do I limit the deletion of cells to 3 when found more. Below is example, here only "Count >=4 must be deleted leaving "Guntersville 45481 & Gadsden 45481" with one cell and "Marion 45481" with all 3 cells as is.

Really appreciate if I could get some help on this.

 

[Joe4]

Is column S ("Count") just a helper column, or is it a column you need to keep and show?
If you need to continue to show it, should it show the original 4 and 5 you have listed there now, or should it show 1 after the duplicate deletions?

 

[tobysimon]

Is column S ("Count") just a helper column, or is it a column you need to keep and show?
If you need to continue to show it, should it show the original 4 and 5 you have listed there now, or should it show 1 after the duplicate deletions?

Thanks for the reply Joe4, it's just a helper. After the deletion it would show as 3. Since 3 is the limit.

 

[Joe4]

It looks like maybe color R is a helper column too.
So you are just looking for duplicate when considering columns P and Q, right?

So based on your example, is this what your expected outcome should look like?

If not, please post us what you want your outcome to look like.

 

[tobysimon]

It looks like maybe color R is a helper column too.
So you are just looking for duplicate when considering columns P and Q, right?

So based on your example, is this what your expected outcome should look like?
View attachment 113828

If not, please post us what you want your outcome to look like.

Below is the Outcome Joe. I'd need column R to remain a concatenate. Hope it helps

 

[Joe4]

Assuming that the counts in column S are the result of a formula and it is not hard-coded, this little VBA procedure should do what you want:

Sub RemoveDups()

    Dim lr As Long
    Dim r As Long
   
    Application.ScreenUpdating = False
   
'   Find last row in column S with data
    lr = Cells(Rows.Count, "S").End(xlUp).Row
   
'   Loop through all rows backwards deleting duplicates > 3
    For r = lr To 2 Step -1
'       Delete row if value in column S > 3
        If Cells(r, "S") > 3 Then Rows(r).Delete
    Next r
   
    Application.ScreenUpdating = True
   
End Sub

 

[tobysimon]

Assuming that the counts in column S are the result of a formula and it is not hard-coded, this little VBA procedure should do what you want:

Sub RemoveDups()

    Dim lr As Long
    Dim r As Long
  
    Application.ScreenUpdating = False
  
'   Find last row in column S with data
    lr = Cells(Rows.Count, "S").End(xlUp).Row
  
'   Loop through all rows backwards deleting duplicates > 3
    For r = lr To 2 Step -1
'       Delete row if value in column S > 3
        If Cells(r, "S") > 3 Then Rows(r).Delete
    Next r
  
    Application.ScreenUpdating = True
  
End Sub

Thank you Joe4, it worked. Appreciate your effort.

 

[Joe4]

You are welcome.
Glad I was able to help!