Consulting

Results 1 to 16 of 16

Thread: Solved: Highlighting Duplicates

  1. #1
    Site Admin
    The Princess
    VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location

    Solved: Highlighting Duplicates

    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

  2. #2
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,897
    Location
    Do both columns have to match?

  3. #3
    VBAX Regular NateO's Avatar
    Joined
    Jun 2004
    Location
    Minneapolis, MN
    Posts
    90
    Location

    Take 2 :)

    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

  4. #4
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    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

  5. #5
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,897
    Location
    I'm with Nate, you sure you want code?

    Another CF could be used as in this attachment:

  6. #6
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    What is CF?
    ~Anne Troy

  7. #7
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    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

  8. #8
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,897
    Location
    Gotcha. CF = Conditional Formatting.

  9. #9
    Knowledge Base Approver VBAX Expert brettdj's Avatar
    Joined
    May 2004
    Location
    Melbourne
    Posts
    649
    Location
    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

  10. #10
    Knowledge Base Approver VBAX Expert brettdj's Avatar
    Joined
    May 2004
    Location
    Melbourne
    Posts
    649
    Location
    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

    [vba]
    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
    [/vba]
    Last edited by brettdj; 06-16-2004 at 06:42 PM.

  11. #11
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,710
    Location
    Though a loop probably isn't the best way if there are 65536 rows of data, this should work.

    [VBA]
    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
    [/VBA]

  12. #12
    Knowledge Base Approver VBAX Expert brettdj's Avatar
    Joined
    May 2004
    Location
    Melbourne
    Posts
    649
    Location
    I think the code needs to work over the entire column range, see below

    Quote Originally Posted by Dreamboat
    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

  13. #13
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,710
    Location
    I missed that part. Try this for the whole column.

    [vba]
    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
    [/vba]

  14. #14
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    It's okay if it matches "usedrange", but I would think "first x columns" on BOTH sheets would be fine too.
    ~Anne Troy

  15. #15
    Knowledge Base Approver VBAX Expert brettdj's Avatar
    Joined
    May 2004
    Location
    Melbourne
    Posts
    649
    Location
    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

    [vba]

    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
    [/vba]
    Last edited by brettdj; 06-17-2004 at 06:47 AM.

  16. #16
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    John:

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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •