PDA

View Full Version : Solved: Highlighting Duplicates



Anne Troy
06-16-2004, 02:46 PM
I want to highlight on sheet 2 any rows that are duplicates of rows on sheet 1 of the attached sample file.

Layout is simple for both sheets:

Column A is a name
Column B is a number

Zack Barresse
06-16-2004, 02:58 PM
Do both columns have to match?

NateO
06-16-2004, 03:05 PM
Concatenate A&B on Sheet1, Name the new range on Sheet1, then use Countif() like in the attached file under Format->Conditional Formatting. Set up the format for A2 on Sheet 2 and copy->Paste Special->Formats for the remainder of the range.

Can't be sure you want VBA here...

Anne Troy
06-16-2004, 03:09 PM
Yes, the "row" has to match.

Yes, I want VBA. As if I have 65,535 of these suckers... :)
We're gonna add these to the KB. I'm just making sure I've got the BEST code 'cause you know I can't trust any code outside here...'cause the best are RIGHT HERE.

Oh, and it would be nice if the whole row matched, regardless of the number of columns. Then that way, we could have *one code fits all*.

Zack Barresse
06-16-2004, 03:11 PM
I'm with Nate, you sure you want code?

Another CF could be used as in this attachment:

Anne Troy
06-16-2004, 03:20 PM
What is CF?

Anne Troy
06-16-2004, 03:21 PM
PS: Just in case you didn't notice....VBA is our FIRST name. I am not putting in our KB a solution that doesn't use it.

Zack Barresse
06-16-2004, 03:25 PM
:) Gotcha. CF = Conditional Formatting.

brettdj
06-16-2004, 04:25 PM
Hi Anne,

I knew I should have built duplicate row functionality into that addin......next version.

Hi firefyr, your solution is formatting Column B on a Column A match whereas I think the entire row needs matching.

As per NateO's suggestion I think that the row will need concatenating to peform the find duplicates, but to handle any possible row configuration the code should look at the sheet usedrange.

COUNTIF won't work on strings longer than 255 characters so this won't be a goer

I'm a little tied up right now but my suggestion is along the lines of

Use the Dictionary object to add concatenated strings of sheet 1 as a Dictionary key, skipping any errors generated when intra sheet duplicate rows are added with the same key. Then add the concatenated strings of sheet 2 to the Dictionary Object as keys and tag the duplicate rows against sheet 1 when an error is generated

Cheers

Dave

brettdj
06-16-2004, 05:14 PM
I've attached a first pass attempt that colours non-blank duplicate rows in Sheet1 in blue (for the hell of it) and non-blank duplicate rows in Sheet2 in red.

The duplicate rows are all set with reference to Sheet1.

The code uses an early bind to Microsoft Script Runtime for the dictionary object

I think that the runtime could be improved by use of arrays, mods & suggestions welcome

Cheers

Dave


Option Explicit

Sub HighDupes()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Row1 As Range, Row2 As Range
Dim Col1 As Range, Col2 As Range
Dim NewStr1 As String, Newstr2 As String

'Needs reference to Microsoft Script Runtime
Dim MyDic As Dictionary

Set MyDic = New Dictionary
Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)

Application.ScreenUpdating = False

For Each Row1 In ws1.UsedRange.Rows
'If rows are blank then skip
If Application.CountA(ws1.Rows(Row1.Row)) > 0 Then

NewStr1 = "Sheet1"
For Each Col1 In ws1.UsedRange.Columns
NewStr1 = NewStr1 & ws1.Cells(Row1.Row, Col1.Column)
Next
If MyDic.exists(NewStr1) Then
'Colour intra sheet duplicates in sheet 1 as blue
ws1.Rows(Row1.Row).Interior.Color = vbBlue
Else
MyDic.Add NewStr1, Row1.Row
End If
End If
Next


For Each Row2 In ws2.UsedRange.Rows
'If rows are blank then skip
If Application.CountA(ws2.Rows(Row2.Row)) > 0 Then
Newstr2 = "Sheet1"
' to match existing keys in Sheet1
For Each Col2 In ws2.UsedRange.Columns
Newstr2 = Newstr2 & ws2.Cells(Row2.Row, Col2.Column)
Next
If MyDic.exists(Newstr2) Then
'Colour inter sheet duplicates in sheet 2 as red
ws2.Rows(Row2.Row).Interior.Color = vbRed
Else
'This row and the Else test is redundant really if the user isn't looking for matches
'within Sheet2.
MyDic.Add Newstr2, Row2.Row
End If
End If
Next

Application.ScreenUpdating = True

Set MyDic = Nothing
Set ws1 = Nothing
Set ws2 = Nothing
End Sub

Jacob Hilderbrand
06-16-2004, 06:07 PM
Though a loop probably isn't the best way if there are 65536 rows of data, this should work.


Option Explicit
Sub FindDuplicates()
Dim x As Long
Dim LastRow As Long
Dim c As Object
Dim FirstAddress As String
LastRow = Sheet2.Range("A65536").End(xlUp).Row
For x = 2 To LastRow
With Sheet1.Range("A:A")
Set c = .Find(what:=Sheet2.Range("A" & x).Text, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If Sheet2.Range("B" & x).Text = Sheet1.Range(c.Address).Offset(0, 1).Text Then
Sheet2.Range("A" & x & ":B" & x).Interior.ColorIndex = 6
Exit Do
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Next x
End Sub

brettdj
06-16-2004, 06:29 PM
I think the code needs to work over the entire column range, see below


Yes, the "row" has to match.

Yes, I want VBA. As if I have 65,535 of these suckers... :)
We're gonna add these to the KB. I'm just making sure I've got the BEST code 'cause you know I can't trust any code outside here...'cause the best are RIGHT HERE.

Oh, and it would be nice if the whole row matched, regardless of the number of columns. Then that way, we could have *one code fits all*.

Dreamboat, my code works over the usedrange so it would match duplicate data in say A1:E1 in sheet 1 with B1:F1 in sheet 2 if the usedrange was 5 columns only in each sheet. Do you want it to match absolutely with column position, ie to look in the identical columns AND rows for the match?

Cheers

Dave

Jacob Hilderbrand
06-16-2004, 06:57 PM
I missed that part. Try this for the whole column.


Option Explicit
Sub FindDuplicates()

Dim x As Long
Dim y As Integer
Dim LastRow As Long
Dim c As Object
Dim FirstAddress As String
Dim String1 As String
Dim String2 As String

LastRow = Sheet2.Range("A65536").End(xlUp).Row
For x = 2 To LastRow
String1 = ""
For y = 1 To 256
String1 = String1 & Sheet2.Cells(x, y).Text
Next y
With Sheet1.Range("A:A")
Set c = .Find(what:=Sheet2.Range("A" & x).Text, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
String2 = ""
For y = 1 To 256
String2 = String2 & Sheet1.Cells(c.Row, y).Text
Next y
If String1 = String2 Then
Sheet2.Range("A" & x).EntireRow.Interior.ColorIndex = 6
Exit Do
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Next x
End Sub

Anne Troy
06-16-2004, 07:05 PM
It's okay if it matches "usedrange", but I would think "first x columns" on BOTH sheets would be fine too. :)

brettdj
06-17-2004, 06:35 AM
I've made a mod to my code to add a separator during the string construction. Otherwise
a bcd
is the same as
abc d

Another potential issue is space trimming, currently the concatentaion will include any spaces at the end of a cell string.

Cheers

Dave



Option Explicit

Sub HighDupes()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Row1 As Range, Row2 As Range
Dim Col1 As Range, Col2 As Range
Dim NewStr1 As String, Newstr2 As String

'Needs reference to Microsoft Scripting Runtime
Dim MyDic As Dictionary

Set MyDic = New Dictionary
Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)

Application.ScreenUpdating = False

For Each Row1 In ws1.UsedRange.Rows
'If rows are blank then skip
If Application.CountA(ws1.Rows(Row1.Row)) > 0 Then

NewStr1 = "Sheet1"
For Each Col1 In ws1.UsedRange.Columns
NewStr1 = NewStr1 & "|" & ws1.Cells(Row1.Row, Col1.Column)
Next
If MyDic.exists(NewStr1) Then
'Colour intra sheet duplicates in sheet 1 as blue
ws1.Rows(Row1.Row).Interior.Color = vbBlue
Else
MyDic.Add NewStr1, Row1.Row
End If
End If
Next


For Each Row2 In ws2.UsedRange.Rows
'If rows are blank then skip
If Application.CountA(ws2.Rows(Row2.Row)) > 0 Then
Newstr2 = "Sheet1"
' to match existing keys in Sheet1
For Each Col2 In ws2.UsedRange.Columns
Newstr2 = Newstr2 & "|" & ws2.Cells(Row2.Row, Col2.Column)
Next
If MyDic.exists(Newstr2) Then
'Colour inter sheet duplicates in sheet 2 as red
ws2.Rows(Row2.Row).Interior.Color = vbRed
Else
'This row and the Else test is redundant really if the user isn't looking for matches
'within Sheet2.
MyDic.Add Newstr2, Row2.Row
End If
End If
Next

Application.ScreenUpdating = True

Set MyDic = Nothing
Set ws1 = Nothing
Set ws2 = Nothing
End Sub

Anne Troy
08-07-2004, 08:37 AM
John:

BrettDJ is away for a couple weeks, I think. You're probably better off making a new question anyway. :)