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
Printable View
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
Do both columns have to match?
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...
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*.
I'm with Nate, you sure you want code?
Another CF could be used as in this attachment:
What is CF?
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.
:) Gotcha. CF = Conditional Formatting.
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
Code: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
Though a loop probably isn't the best way if there are 65536 rows of data, this should work.
Code: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?Quote:
Originally Posted by Dreamboat
Cheers
Dave
I missed that part. Try this for the whole column.
Code: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. :)
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
Code: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
John:
BrettDJ is away for a couple weeks, I think. You're probably better off making a new question anyway. :)