VBA for Duplicates Across 13 Columns

[mrsbrannon]

Hello everyone,

I am trying to get a VBA code that will highlight duplicates found across 13 columns of data, possibly 100+ rows of data. So I'm looking for duplicated rows across those 13 columns. See below:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]DOB[/TD]
[TD]Address[/TD]
[TD]Phone[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[/TR]
[TR]
[TD]John Brown[/TD]
[TD]1/1/1992[/TD]
[TD]123 main[/TD]
[TD]1234[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Brown[/TD]
[TD]1/1/1992[/TD]
[TD]123 main[/TD]
[TD]1234[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Please note that my data for checking starts in column C, not A. So it's Columns C thru O.

Thank you!

 

[Roderick_E]

Hello everyone,

I am trying to get a VBA code that will highlight duplicates found across 13 columns of data, possibly 100+ rows of data. So I'm looking for duplicated rows across those 13 columns. See below:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]DOB[/TD]
[TD]Address[/TD]
[TD]Phone[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[TD]Etc[/TD]
[/TR]
[TR]
[TD]John Brown[/TD]
[TD]1/1/1992[/TD]
[TD]123 main[/TD]
[TD]1234[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Brown[/TD]
[TD]1/1/1992[/TD]
[TD]123 main[/TD]
[TD]1234[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Please note that my data for checking starts in column C, not A. So it's Columns C thru O.

Thank you!

Why not just use conditional format? Otherwise check out xlsupertool Sheet_Comparer rodericke.com/xlsuper

 

[mrsbrannon]

It's not as clean as I would like it with conditional formatting. I will check out the link. Thanks.

 

[rlv01]

A couple of questions:

1. Can you be more specific about how you are defining what a "duplicate" is? Only names? Only rows? That kind of thing.
2. What do you want to have happen when a duplicate is identified?

 

[mrsbrannon]

[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Phone[/TD]
[TD]State[/TD]
[TD]City[/TD]
[TD]Age[/TD]
[TD]Height[/TD]
[TD]Fav. Color[/TD]
[TD]Fav. Candy[/TD]
[TD]Fav. Food[/TD]
[TD]Blood Type[/TD]
[TD]Hair Color[/TD]
[TD]Eye Color[/TD]
[TD]Coffee or Tea[/TD]
[/TR]
[TR]
[TD]John Brown
[/TD]
[TD]1234[/TD]
[TD]LA[/TD]
[TD]New Orleans[/TD]
[TD]15[/TD]
[TD]5'2[/TD]
[TD]Blue[/TD]
[TD]Nerds[/TD]
[TD]Italian[/TD]
[TD]O+[/TD]
[TD]Brown[/TD]
[TD]Blue[/TD]
[TD]Coffee[/TD]
[/TR]
[TR]
[TD]John Brown[/TD]
[TD]1234[/TD]
[TD]LA[/TD]
[TD]New Orleans[/TD]
[TD]15[/TD]
[TD]5'2[/TD]
[TD]Blue[/TD]
[TD]Nerds[/TD]
[TD]Italian[/TD]
[TD]O+[/TD]
[TD]Brown[/TD]
[TD]Blue[/TD]
[TD]Coffee[/TD]
[/TR]
</tbody>[/TABLE]


1. The sample table shows kinda what I'm looking for in a duplicate. I want to find identical rows (duplicates) across all 13 of those columns. The headers are not these, but this is an idea of how the data lays out (starting with column C)

2. I want it to highlight the duplicate(s) AND original in YELLOW when found

Does that help?

 

[mrsbrannon]

And my data starts on ROW 2. Not sure if that helps or not.

 

[Fluff]

How about

Sub HighlightDupes()

   Dim Cl As Range
   Dim ValU
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
         ValU = Join(Application.Transpose(Application.Transpose(Cl.Resize(, 13).Value)), ",")
         If Not .exists(ValU) Then
            .Add ValU, Cl
         Else
            .Item(ValU).Resize(, 13).Interior.Color = vbYellow
            Cl.Resize(, 13).Interior.Color = vbYellow
         End If
      Next Cl
   End With
End Sub

 

[mrsbrannon]

How about

Sub HighlightDupes()

   Dim Cl As Range
   Dim ValU
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
         ValU = Join(Application.Transpose(Application.Transpose(Cl.Resize(, 13).Value)), ",")
         If Not .exists(ValU) Then
            .Add ValU, Cl
         Else
            .Item(ValU).Resize(, 13).Interior.Color = vbYellow
            Cl.Resize(, 13).Interior.Color = vbYellow
         End If
      Next Cl
   End With
End Sub

Thank you! That works when I run the Macro. Is there a way to automate it? Also, is there a way to have it recognize if the rows are totally blank and not highlight duplicate blanks?

 

[Fluff]

This will ignore any row if col C is blank

Sub HighlightDupes()

   Dim Cl As Range
   Dim ValU
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
         If Len(Cl) > 0 Then
            ValU = Join(Application.Transpose(Application.Transpose(Cl.Resize(, 13).Value)), ",")
            If Not .exists(ValU) Then
               .Add ValU, Cl
            Else
               .Item(ValU).Resize(, 13).Interior.Color = vbYellow
               Cl.Resize(, 13).Interior.Color = vbYellow
            End If
         End If
      Next Cl
   End With
End Sub

As for automating it, when would you want it to run?

 

[mrsbrannon]

I guess when the sheet is opened? The data is collected/pulled over daily/weekly. So either as it's opened or as the data is added? I'm not sure how to phrase that correctly.