Find duplicate rows of multiple cells...

[spacely]

Hi ...

I have a rectangular arrangement of cells, and want to detect if any row has the same entries as any other row, in the range of rows of interest. A trigger at the end of the duplicate rows, or a conditional format to display which are copies of each other would be great.

So:

1 3 6 4 3 2 1 3
4 5 6 7 3 2 1 4
6 7 8 1 0 8 7 6
4 5 6 7 3 2 1 4

..would flag as row 2 and 4 being identical.

Thanks!

 

[Fluff]

Did you copy the data & then paste it again, below itself?

 

[JumpingCrab]

Sorry Jump, I don't get your code. I have rows not columns, so why it's scanning A only?
Not sure where to put the code... I get #NAME ? so far...

Marzio, looks like yours will identify duplicated cells in a column, but not all the combinations that determine if 2 whole rows are identical. Or maybe I need to expand that idea?

Sorry, my mistake.
The cell G1 has to be =HASH(A1:H1) of course. The code concatenates the whole row and then creates the hash.

JL

 

[spacely]

Did you copy the data & then paste it again, below itself?

No, but I see a mysterious entry 800 rows below in column A for some reason. I think excel auto-formatted to that row when I did some operation. Below that, the font is normal color. Don't worry about it... it's excel being a butt

 

[JumpingCrab]

Fluff, this is an elegant solution. I have a question though. Why do you have to nest two Transpose functions in the Join function? It flips rows to columns and back, but why is that needed?

Thx,
JL

How about

Sub ColourDuplicates()

   Dim Valu As String
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
         Valu = Join(Application.Transpose(Application.Transpose(Cl.Resize(, 8))))
         If Not .exists(Valu) Then
            .Add Valu, Cl.Resize(, 8)
         Else
            Cl.Resize(, 8).Interior.Color = 220
            .Item(Valu).Interior.Color = 220
         End If
      Next Cl
   End With

End Sub

 

[Fluff]

It turns a 2d array into a 1d array, so that you can then use Join (which only works on a 1d array)

 

[JumpingCrab]

Ok. Thanks for the clarification. Apparently a range like A1:A8 is not seen as a 1d array.
I learned something very useful from this thread. Thanks for your solution.

JL

 

[ed9213]

Thanks Fluff. With a more general column count, I made it work they way I needed.

Sub ColourDuplicates()
' shift+ctrl+C
Dim Valu As String
Dim Cl As Range

ncol = Selection.Columns.Count
With CreateObject("scripting.dictionary")
For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
Valu = Join(Application.Transpose(Application.Transpose(Cl.Resize(, ncol + 1))))
If Not .exists(Valu) Then
.Add Valu, Cl.Resize(, ncol + 1)
Else
Cl.Resize(, ncol + 1).Font.Color = vbRed
.Item(Valu).Font.Color = vbRed
End If
Next Cl
End With

End Sub

====
I thought that Spacely's last code would have solved my analysis dilemma also. When I ran the code, though, it only matched the data in the first two columns. My spreadsheet, 17700 rows X 22 columns, Excel 2010, has adjacent data in at least the first 9 columns, then there are gaps. Is there a tweak that will compare more than the first two columns, or perhaps the whole row, for comparison?
Thanks.

 

[Fluff]

How about

Sub ColourDuplicates()
   Dim Valu As String
   Dim Cl As Range
   Dim UsdCols As Long
   
   UsdCols = Cells(1, Columns.Count).End(xlToLeft).Column
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
         Valu = Join(Application.Transpose(Application.Transpose(Cl.Resize(, ncol))))
         If Not .exists(Valu) Then
         .Add Valu, Cl.Resize(, ncol)
         Else
         Cl.Resize(, ncol).Font.Color = vbRed
         .Item(Valu).Font.Color = vbRed
         End If
      Next Cl
   End With

End Sub

 

[ed9213]

Fluff, that results in a Run-time error 1004 - Application-defined or object-defined error.

 

[Fluff]

Apologies, I wasn't thinking. It should be

Sub ColourDuplicates()
   Dim Valu As String
   Dim Cl As Range
   Dim UsdCols As Long
   
   UsdCols = Cells(1, Columns.Count).End(xlToLeft).Column
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
         Valu = Join(Application.Transpose(Application.Transpose(Cl.Resize(, UsdCols))))
         If Not .exists(Valu) Then
         .Add Valu, Cl.Resize(, UsdCols)
         Else
         Cl.Resize(, UsdCols).Font.Color = vbRed
         .Item(Valu).Font.Color = vbRed
         End If
      Next Cl
   End With

End Sub