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
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
~Anne Troy
Do both columns have to match?
Regards, Zack Barresse
Check out the KB! :|: BOARD TAGS: WHAT ARE THEY AND HOW DO I USE THEM
What is a Microsoft MVP? | Free Microsoft Courses | My Book on Excel Tables
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...
Regards,
Nate Oliver
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*.
~Anne Troy
I'm with Nate, you sure you want code?
Another CF could be used as in this attachment:
Regards, Zack Barresse
Check out the KB! :|: BOARD TAGS: WHAT ARE THEY AND HOW DO I USE THEM
What is a Microsoft MVP? | Free Microsoft Courses | My Book on Excel Tables
What is CF?
~Anne Troy
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.
~Anne Troy
Gotcha. CF = Conditional Formatting.
Regards, Zack Barresse
Check out the KB! :|: BOARD TAGS: WHAT ARE THEY AND HOW DO I USE THEM
What is a Microsoft MVP? | Free Microsoft Courses | My Book on Excel Tables
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
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
Last edited by brettdj; 06-16-2004 at 06:42 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© Loop While Not c Is Nothing And c.Address <> FirstAddress End If End With Next x End Sub
I think the code needs to work over the entire column range, see below
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?Originally Posted by Dreamboat
Cheers
Dave
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© Loop While Not c Is Nothing And c.Address <> FirstAddress End If End With Next x End Sub
It's okay if it matches "usedrange", but I would think "first x columns" on BOTH sheets would be fine too.
~Anne Troy
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
Last edited by brettdj; 06-17-2004 at 06:47 AM.
John:
BrettDJ is away for a couple weeks, I think. You're probably better off making a new question anyway.
~Anne Troy