Highlighting or Removing Non Successive Duplicates

[aa720]

Hi there,

After researching for hours, I believe I have come to the right place. I need some help with some duplicates and the best way to identify them in a spreadsheet meeting the criteria below.

I have the data below in column A:

9765
9765
9765
3265
3265
3265
8764
8764
8764
9765
9765
9765
9765
8976
8976

<tbody>
</tbody>

I need to find a way to highlight all set of duplicate values after the first initial set of duplicates. The first initial set of duplicates would be ignored. In the example above, all the cells containing 9765 after the first set in rows 1-3 would need to be highlighted as shown. In reality, I do not need it to be highlighted necessarily, but I do need a way to identify them so I can remove them manually. Or if there is a code that can remove the duplicate sets for me that would be amazing.

Criteria:
-identify duplicate set of values that are not successive to the first initial set of duplicated values
-highlight or format in a way I could manually isolate and delete entire rows of data
-essentially to leave first set of duplicated values unformatted
-can have more than on duplicate sets. all except the first initial set would be included in the formatting

Let me know if I can be more clear.

Thanks a ton,

AA720

 

[Peter_SSs]

Welcome to the MrExcel board!

Assuming ...
- Data in column A with a heading (if no heading we could temporarily have the code add one)
- Nothing in columns B:C (give details of what else is on the sheet and where if this assumption is incorrect)

.. try this in a copy of your workbook.
It should remove those duplicates you don't want.

Sub RemoveAfterFirstSet()
  Dim rCrit As Range
  
  Set rCrit = Range("B1:B2")
  Application.ScreenUpdating = False
  rCrit.Cells(2).Formula = "=COUNTIF(A$2:A2,A2)=ROWS(A$2:A2)-MATCH(A2,A$2:A2,0)+1"
  Range("A1", Range("A" & Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Range("C1"), Unique:=False
  Columns("A:B").Delete
  Application.ScreenUpdating = True
End Sub

 

[aa720]

Hi Peter_SSs,

Thank you for your quick response!

I tried the code you provided and it was close.

-You are correct all columns have headers.
-Data is present in columns B-CD. The best method might be to remove the entire row containing the duplicate sets.

This is amazing.

Thank you for your response,

AA720

 

[aa720]

Hi Peter_SSs,

I apologize if this isn't in the correct format and thank you in advance for your response.

Here is an updated table. The number of colunms is quite long as well as are the number of rows on my spreadsheet. Applying the criteria from before, the entire rows containing the duplicate sets after the first initial duplicate set would need to be removed.

I apologize for not stating this beforehand.

Thank you,

AA720

accession	data	data1	data2	data3
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
888888	jake	smith	12/1/2014	9876
888888	jake	smith	12/1/2014	9876
888888	jake	smith	12/1/2014	9876
888888	jake	smith	12/1/2014	9876
888888	jake	smith	12/1/2014	9876
888888	jake	smith	12/1/2014	9876
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
99999	tom	smith	1/20/2013	1234
77777	bert	smith	1/12/2012	6564
77777	bert	smith	1/13/2012	6565
77777	bert	smith	1/14/2012	6566
77777	bert	smith	1/15/2012	6567
77777	bert	smith	1/16/2012	6568
888888	jake	smith	12/1/2014	9876
888888	jake	smith	12/2/2014	9877
888888	jake	smith	12/3/2014	9878
888888	jake	smith	12/4/2014	9879
888888	jake	smith	12/5/2014	9880
888888	jake	smith	12/6/2014	9881

<colgroup><col span="3"><col><col></colgroup><tbody>
</tbody>

 

[Peter_SSs]

From your sample data, I'm not entirely sure whether we need to check multiple columns for repeats or just one. I've assumed just one and you set it in the 'Const' line of the code below.
I've taken as fixed that the data occupies columns B:CD and that nothing is to the right of column CD.

Sub RemoveAfterFirstSet_v2()
  Dim rCrit As Range
  
  Const ColToChk As String = "F" '<- Column we need to look at for the clusters
  
  Set rCrit = Range("CE1:CE2")
  Application.ScreenUpdating = False
  rCrit.Cells(2).Formula = Replace("=COUNTIF(#$2:#2,#2)=ROWS(#$2:#2)-MATCH(#2,#$2:#2,0)+1", "#", ColToChk)
  Range("B1:CD1").Resize(Range(ColToChk & Rows.Count).End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=rCrit.Cells(1, 2), Unique:=False
  Columns("B:CE").Delete
  Application.ScreenUpdating = True
End Sub

 

[kalak]

Just curious, but is this code somewhat along the lines of what you want?

No headers needed, and doesn't matter whatever's after col CD.
Rows to deletecolored cyan but trivial to change "Interior.Color = vbCyan" to "Delete" if that's wanted.

Sub kkk()

Dim dic As Object, a, b As Boolean, s
Dim i As Long, x, z As String
Set dic = CreateObject("scripting.dictionary")
a = Range("B1", Cells(Rows.Count, "b").End(3))

For i = 1 To UBound(a)
    dic(a(i, 1)) = Join(Array(dic(a(i, 1)), i))
Next i

For Each x In dic.keys
    s = Split(Mid(dic(x), 2))
    For i = 1 To UBound(s)
        If s(i) - s(i - 1) > 1 Then b = True
        If b Then
            If Len(z) < 240 Then
                z = z & ",B" & s(i) & ":CD" & s(i)
            Else
                Range(Mid(z, 2)).Interior.Color = vbCyan
                z = ",B" & s(i) & ":CD" & s(i)
             End If
        End If
    Next i
    b = False
Next x

Range(Mid(z, 2)).Interior.Color = vbCyan
End Sub