Consulting

Results 1 to 16 of 16

Thread: 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

    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,940
    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,940
    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,940
    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

    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.

  11. #11
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    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

  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,712
    Location
    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

  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

    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.

  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
  •