Results 1 to 25 of 25

Thread: [RESOLVED] highlight duplicate rows include original instance.

Hybrid View

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Resolved [RESOLVED] highlight duplicate rows include original instance.

    I want all the duplicate rows highlighted in a worksheet along with original instance e.g. if I have row 1 with some data in multiple columns and the same date appears on row 20 then the macro should highlight both the row items in some same color. I got the below code through google search but when it try to run it gets stuck on the below line and shows error Run time Error '13' type mismatch. Excel version used by me is excel 2010. can someone help.

    Code:
    NewStr1 = NewStr1 & "||" & ws1.Cells(Row1.Row, Col1.Column) ' it's throwing runtime error on this line.
    Code:
    Option Explicit
    Sub HighDupes()
    Dim ws1 As Worksheet
    Dim Row1 As Range
    Dim Col1 As Range
    Dim NewStr1 As String
    'Needs reference to Microsoft Scripting Runtime
    Dim MyDic As Dictionary
    Set MyDic = New Dictionary
    Set ws1 = ActiveWorkbook.Sheets(1)
    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) ' it's throwing runtime error on this line.
    Next
    If MyDic.exists(NewStr1) Then
    'Colour intra sheet duplicates in sheet 1 as blue
    ws1.Rows(Row1.Row).Interior.Color = vbBlue
    ws1.Rows(MyDic(NewStr1)).Interior.Color = vbRed
    Else
    MyDic.Add NewStr1, Row1.Row
    End If
    End If
    Next
    Application.ScreenUpdating = True
    Set MyDic = Nothing
    Set ws1 = Nothing
    End Sub
    Last edited by abhay_547; Mar 1st, 2018 at 12:30 AM.

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: highlight duplicate rows include original instance.

    does the error occur on all columns? or just some?
    you could try to explicitly convert the cell value to string, or use the cell text specifically
    Code:
    NewStr1 = NewStr1 & "||" & cstr(ws1.Cells(Row1.Row, Col1.Column))
    '    OR
    NewStr1 = NewStr1 & "||" & ws1.Cells(Row1.Row, Col1.Column).text
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  3. #3

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: highlight duplicate rows include original instance.

    Great. It works now. I just need 1 more addition .i.e. to copy red or blue (either one) highlighted cells data including header (don't want to hard code the range, highlighted in bold) in a new sheet and name it as "Filtered out data" and delete all red and blue colored rows from the original worksheet.

    Code:
    Sheets.Add
        ActiveSheet.Name = "Filtered Out Data"
       ActiveSheet.Range("$A$1:$BG$3040").AutoFilter Field:=1, Criteria1:=RGB(0, 0 _
            , 255), Operator:=xlFilterCellColor
          
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("Filtered Out Data").Select
        Range("A1").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Range("A1").Select
    Last edited by abhay_547; Mar 1st, 2018 at 03:27 PM.

  4. #4
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: highlight duplicate rows include original instance.

    as you do not store the rows that match, only change the colour, you would have to loop all the rows again

    i would look at storing all the matched rows, to be able to work with them later
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  5. #5

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: highlight duplicate rows include original instance.

    Ok. got it. in that case how do i filter for both blue and red rows at one go from base data and also I don't want to hard code the filter range (highlighted in bold). can you help


    Code:
    Option Explicit
    Sub HighDupes()
    Dim ws1 As Worksheet
    Dim Row1 As Range
    Dim Col1 As Range
    Dim NewStr1 As String
    'Needs reference to Microsoft Scripting Runtime
    Dim MyDic As Dictionary
    Set MyDic = New Dictionary
    Set ws1 = ActiveWorkbook.Sheets(1)
    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 & "||" & cstr(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
    ws1.Rows(MyDic(NewStr1)).Interior.Color = vbRed
    Else
    MyDic.Add NewStr1, Row1.Row
    End If
    End If
    Next
    Application.ScreenUpdating = True
    Set MyDic = Nothing
    Set ws1 = Nothing
    
    Sheets.Add
        ActiveSheet.Name = "Filtered Out Data"
    Sheets(1).Select
       ActiveSheet.Range("$A$1:$BG$3040").AutoFilter Field:=1, Criteria1:=RGB(0, 0 _
            , 255), Operator:=xlFilterCellColor
          
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("Filtered Out Data").Select
        Range("A1").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Sheets(1).Select
       Cells.Select
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Range("A1").Select
    End Sub

  6. #6
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: highlight duplicate rows include original instance.

    your original macro could have multiple matched rows, that did not all match each other
    should they all get to copied (moved) to the same worksheet, or should the different matched rows each be moved to different worksheets?

    do you actually need to colour the rows, or just move them?
    Last edited by westconn1; Mar 2nd, 2018 at 03:49 AM.
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  7. #7

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: highlight duplicate rows include original instance.

    Ok. Color coding is not important, I thought it makes it easy to identify the data using colors. I just need same original set of rows and same duplicate set of rows to be identified first and then move original set of rows to "filtered out data" worksheet and delete the both original set of rows and duplicated set of rows from Sheets (1). Color coding is just to identify the data which needs to be deleted from sheets(1) using the duplicates criteria.

  8. #8

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: highlight duplicate rows include original instance.

    can someone help with the above code.

  9. #9
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: highlight duplicate rows include original instance.

    Can you zip and attach a "before and after" example? I'm still a little unclear what you want exactly.

  10. #10

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: highlight duplicate rows include original instance.

    Quote Originally Posted by vbfbryce View Post
    Can you zip and attach a "before and after" example? I'm still a little unclear what you want exactly.
    There were no attachments in this thread. I have a data in which I have some duplicate rows items (spanning across multiple colums) and I want to identify those duplicate row items along with original set of rows and move the original set of rows to a new worksheet and delete both original and duplicate set of rows. the initial code posted was to identify the duplicate and original set of rows through some color coding .i.e. blue and red.

  11. #11
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: highlight duplicate rows include original instance.

    you can test with this modification to your code, see if it does what you want

    Code:
    Dim ws1 As Worksheet
    Dim Row1 As Range
    Dim Col1 As Range
    Dim NewStr1 As String
    'Needs reference to Microsoft Scripting Runtime
    Dim MyDic As Dictionary
    Set MyDic = New Dictionary
    Set ws1 = ActiveWorkbook.Sheets("sheet2")
    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 = "ws1.name"
            For Each Col1 In ws1.UsedRange.Columns
            NewStr1 = NewStr1 & "||" & ws1.Cells(Row1.row, Col1.Column) ' it's throwing runtime error on this line.
            Next
            If MyDic.exists(NewStr1) Then
                Set rng = MyDic.Item(NewStr1)
                
                Set rng = Union(rng, Cells(Row1.row, 1).Resize(, ws1.UsedRange.Columns.Count))
                Set MyDic.Item(NewStr1) = rng
                'Colour intra sheet duplicates in sheet 1 as blue
                ''ws1.Rows(Row1.row).Interior.Color = vbBlue
                ''ws1.Rows(MyDic(NewStr1)).Interior.Color = vbRed
                Else
                MyDic.Add NewStr1, ws1.Cells(Row1.row, 1).Resize(, ws1.UsedRange.Columns.Count)
            End If
        End If
    Next
    For Each rng In MyDic.Items
        x = x + 1
        Debug.Print rng.Address
        If rng.Areas.Count > 1 Or rng.Rows.Count > 1 Then
            Set sht = ws1.Parent.Sheets.Add
            rc = 1
            sht.Name = "dup" & x
            For Each rw In rng.Rows
                sht.Cells(rc, 1).Resize(, rw.Columns.Count).Value = rw.Value
                rc = rc + 1
            Next
            rng.Delete xlShiftUp
        End If
    Next
    Application.ScreenUpdating = True
    Set MyDic = Nothing
    Set ws1 = Nothing
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  12. #12
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: highlight duplicate rows include original instance.

    There were no attachments in this thread
    we know that, bryce was asking you to attach one, so much easier to work with than trying to create a similar data set
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  13. #13

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: highlight duplicate rows include original instance.

    It's working but it moves each original and duplicate set of rows into a separate sheet but I want all the original and duplicate set of rows to be moved into one worksheet and name it as "Filtered Out data". the dup1, dup2 text which is used by you to name the worksheet is useful, can we enter the same text in the last column of "Filtered out data" worksheet instead. e.g. below snapshot.
    Attached Images Attached Images  

  14. #14
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: highlight duplicate rows include original instance.

    but I want all the original and duplicate set of rows to be moved into one worksheet and name it as "Filtered Out data"
    i an sure by now you should be able to modify the code to achieve that result

    can we enter the same text in the last column of "Filtered out data" worksheet
    that should also be very easy to do
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  15. #15

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: highlight duplicate rows include original instance.

    I tried the below but it shows errors on the lines which are highlighted in bold and blue. instead I can use the combine sheets method post running the entire macro, but I think we don't need to use the combine sheets macro over here, it can be avoided and we can incorporate the logic in the main macro but I am not clear on how it can be achieved. Would appreciate if you can help.

    Below is main macro slightly tweaked by me to attempt to copy all duplicate and original set of rows into one sheet .i.e. Filtered out data, but it shows a compile error: variable not defined if we retain option explicit on top and if I remove the option explicit then it shows Object required error on the next line which is highlighted bold and blue:

    Code:
    Option Explicit
    Sub IdentifyDuplicatesandmove()
    
    Dim ws1 As Worksheet
    Dim Row1 As Range
    Dim Col1 As Range
    Dim NewStr1 As String
    'Needs reference to Microsoft Scripting Runtime
    Dim MyDic As Dictionary
    Set MyDic = New Dictionary
    Set ws1 = ActiveWorkbook.Sheets("Sheet2")
    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 = "ws1.name"
            For Each Col1 In ws1.UsedRange.Columns
            NewStr1 = NewStr1 & "||" & CStr(ws1.Cells(Row1.row, Col1.Column))
            Next
            If MyDic.exists(NewStr1) Then
                Set rng = MyDic.Item(NewStr1)  ' Compile error: variable not defined
                
                Set rng = Union(rng, Cells(Row1.row, 1).Resize(, ws1.UsedRange.Columns.Count))
                Set MyDic.Item(NewStr1) = rng
                'Colour intra sheet duplicates in sheet 1 as blue
                ''ws1.Rows(Row1.row).Interior.Color = vbBlue
                ''ws1.Rows(MyDic(NewStr1)).Interior.Color = vbRed
                Else
                MyDic.Add NewStr1, ws1.Cells(Row1.row, 1).Resize(, ws1.UsedRange.Columns.Count)
            End If
        End If
    Next
    For Each rng In MyDic.Items
        x = x + 1
        Debug.Print rng.Address
        If rng.Areas.Count > 1 Or rng.Rows.Count > 1 Then
            Set sht = ws1.Parent.Sheets.Add
            rc = 1
            sht.Name = "Filtered Out Data"
           
                sht.Cells(rc, 1).Resize(, rw.Columns.Count).Value = rw.Value
                rc = rc + 1
         
            rng.Delete xlShiftUp
        End If
    Next
    Application.ScreenUpdating = True
    Set MyDic = Nothing
    Set ws1 = Nothing
    End Sub
    below is the combine sheet macro which can be run post running the original macro and it would work, but I believe it would be better if we add the logic in the main macro itself instead of first getting them in separate sheets and then combining.

    Code:
    Sub combineshts()
    Dim i As Integer
        Dim xTCount As Variant
        Dim xWs As Worksheet
      
        xTCount = 1
        
        Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))
        xWs.Name = "Filtered Out Data"
        Sheets("Sheet2").Range("A1").EntireRow.Copy Destination:=xWs.Range("A1")
         
        For i = 2 To Worksheets.Count
         For Each xWs In ThisWorkbook.Worksheets
          If xWs.Name <> "Pivot" And xWs.Name <> "Pivot2" And xWs.Name <> "Mapping" Then
           Worksheets(i).Range("A1").CurrentRegion.Offset(CInt(xTCount), 0).Copy _
           Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).row + 1, 1)
          End If
         Next
        Next
        Application.DisplayAlerts = False
        For Each xWs In ActiveWorkbook.Sheets
        If Left(xWs.Name, 3) = "dup" Then
            xWs.Delete
        End If
    Next xWs
    Application.DisplayAlerts = True
    End Sub
    Last edited by abhay_547; Mar 4th, 2018 at 12:49 PM.

  16. #16
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: highlight duplicate rows include original instance.

    Code:
            If MyDic.exists(NewStr1) Then
                Set MyDic.Item(NewStr1) = union(MyDic.Item(NewStr1),Cells(Row1.row, 1).Resize(, ws1.UsedRange.Columns.Count))
                Else
                MyDic.Add NewStr1, ws1.Cells(Row1.row, 1).Resize(, ws1.UsedRange.Columns.Count)
            End If
    you can replace the error part with as above

    surly you would know by now that variable not defined means to dimension (dim) the variable

    Code:
    Set sht = ws1.Parent.Sheets.Add       
     sht.Name = "duplicates"
     rc = 1
    For Each rng In MyDic.Items
        x = x + 1
        Debug.Print rng.Address
        If rng.Areas.Count > 1 Or rng.Rows.Count > 1 Then
            For Each rw In rng.Rows
                sht.Cells(rc, 1).Resize(, rw.Columns.Count).Value = rw.Value
                sht.offset(,rw.columns.count) = "dup" & x
                rc = rc + 1
            Next
            rng.Delete xlShiftUp
        End If
    Next
    the above code should put all the duplicates into the same sheet, with dup number
    you will still need to define all additional variables, up to you to figure out what they are
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  17. #17

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: highlight duplicate rows include original instance.

    Ok. I have updated the code by defining variables, but it seems something is going wrong. It shows compile error on the line highlighted in blue. Can you please help.

    Code:
    Option Explicit
    
    Sub IdentifyDuplicatesandmovenew()
    
    Dim ws1 As Worksheet
    Dim Row1 As Range
    Dim Col1 As Range
    Dim NewStr1 As String
    'Needs reference to Microsoft Scripting Runtime
    Dim MyDic As Dictionary
    Set MyDic = New Dictionary
    Set ws1 = ActiveWorkbook.Sheets("Raw Data")
    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 = "ws1.name"
            For Each Col1 In ws1.UsedRange.Columns
            NewStr1 = NewStr1 & "||" & CStr(ws1.Cells(Row1.Row, Col1.Column))
            Next
           If MyDic.exists(NewStr1) Then
                Set MyDic.Item(NewStr1) = Union(MyDic.Item(NewStr1), Cells(Row1.Row, 1).Resize(, ws1.UsedRange.Columns.Count))
                Else
                MyDic.Add NewStr1, ws1.Cells(Row1.Row, 1).Resize(, ws1.UsedRange.Columns.Count)
            End If
        End If
    Next
    Dim sht As Worksheet
    Dim rc As Integer
    Dim rng As Range
    Dim x As Integer
    Dim rw As Range
    Set sht = ws1.Parent.Sheets.Add
     sht.Name = "duplicates"
     rc = 1
    For Each rng In MyDic.Items
        x = x + 1
        Debug.Print rng.Address
        If rng.Areas.Count > 1 Or rng.Rows.Count > 1 Then
            For Each rw In rng.Rows
                sht.Cells(rc, 1).Resize(, rw.Columns.Count).Value = rw.Value
                sht.Offset(, rw.Columns.Count) = "dup" & x ' Compile Error: Method or Data Member not found.
                rc = rc + 1
            Next
            rng.Delete xlShiftUp
        End If
    Next
    
    Application.ScreenUpdating = True
    Set MyDic = Nothing
    Set ws1 = Nothing
    
    End Sub

  18. #18
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: highlight duplicate rows include original instance.

    i was in a bit of a hurry to finish, so did not test any of the updated code
    should have been
    Code:
    sht.cells(rc,1),Offset(, rw.Columns.Count) = "dup" & x
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  19. #19

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: highlight duplicate rows include original instance.

    Now it shows syntax error on the updated line (highlighted in blue)


    Code:
    Option Explicit
    
    Sub IdentifyDuplicatesandmovenew()
    
    Dim ws1 As Worksheet
    Dim Row1 As Range
    Dim Col1 As Range
    Dim NewStr1 As String
    'Needs reference to Microsoft Scripting Runtime
    Dim MyDic As Dictionary
    Set MyDic = New Dictionary
    Set ws1 = ActiveWorkbook.Sheets("Raw Data")
    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 = "ws1.name"
            For Each Col1 In ws1.UsedRange.Columns
            NewStr1 = NewStr1 & "||" & CStr(ws1.Cells(Row1.Row, Col1.Column))
            Next
           If MyDic.exists(NewStr1) Then
                Set MyDic.Item(NewStr1) = Union(MyDic.Item(NewStr1), Cells(Row1.Row, 1).Resize(, ws1.UsedRange.Columns.Count))
                Else
                MyDic.Add NewStr1, ws1.Cells(Row1.Row, 1).Resize(, ws1.UsedRange.Columns.Count)
            End If
        End If
    Next
    Dim sht As Worksheet
    Dim rc As Integer
    Dim rng As Range
    Dim x As Integer
    Dim rw As Range
    Set sht = ws1.Parent.Sheets.Add
     sht.Name = "duplicates"
     rc = 1
    For Each rng In MyDic.Items
        x = x + 1
        Debug.Print rng.Address
        If rng.Areas.Count > 1 Or rng.Rows.Count > 1 Then
            For Each rw In rng.Rows
                sht.Cells(rc, 1).Resize(, rw.Columns.Count).Value = rw.Value
                sht.cells(rc,1),Offset(, rw.Columns.Count) = "dup" & x ' Compile Error: syntax error.
                rc = rc + 1
            Next
            rng.Delete xlShiftUp
        End If
    Next
    
    Application.ScreenUpdating = True
    Set MyDic = Nothing
    Set ws1 = Nothing
    
    End Sub

  20. #20
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: highlight duplicate rows include original instance.

    oops
    should be .offset
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  21. #21

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: highlight duplicate rows include original instance.

    Now it shows Run time error '424' Object required on the line highlighted in blue.

    Code:
    Option Explicit
    
    Sub IdentifyDuplicatesandmovenew()
    
    Dim ws1 As Worksheet
    Dim Row1 As Range
    Dim Col1 As Range
    Dim NewStr1 As String
    'Needs reference to Microsoft Scripting Runtime
    Dim MyDic As Dictionary
    Set MyDic = New Dictionary
    Set ws1 = ActiveWorkbook.Sheets("Raw Data")
    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 = "ws1.name"
            For Each Col1 In ws1.UsedRange.Columns
            NewStr1 = NewStr1 & "||" & CStr(ws1.Cells(Row1.Row, Col1.Column))
            Next
           If MyDic.exists(NewStr1) Then
                Set MyDic.Item(NewStr1) = Union(MyDic.Item(NewStr1), Cells(Row1.Row, 1).Resize(, ws1.UsedRange.Columns.Count))
                Else
                MyDic.Add NewStr1, ws1.Cells(Row1.Row, 1).Resize(, ws1.UsedRange.Columns.Count)
            End If
        End If
    Next
    Dim sht As Worksheet
    Dim rc As Integer
    Dim rng As Range
    Dim x As Integer
    Dim rw As Range
    Set sht = ws1.Parent.Sheets.Add
     sht.Name = "duplicates"
     rc = 1
    For Each rng In MyDic.Items
        x = x + 1
        Debug.Print rng.Address
        If rng.Areas.Count > 1 Or rng.Rows.Count > 1 Then
            For Each rw In rng.Rows
                sht.Cells(rc, 1).Resize(, rw.Columns.Count).Value = rw.Value
                sht.cells(rc,1).Offset(, rw.Columns.Count) = "dup" & x ' Compile Error: syntax error.
                rc = rc + 1
            Next
            rng.Delete xlShiftUp
        End If
    Next
    
    Application.ScreenUpdating = True
    Set MyDic = Nothing
    Set ws1 = Nothing
    
    End Sub

  22. #22
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: highlight duplicate rows include original instance.

    for whatever reason, while rng variable does hold a range when the mydic item is assigned to it, it will only work if rng is of type variant, so dim rng as variant, or just dim rng
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  23. #23

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: highlight duplicate rows include original instance.

    Got it. It works now. Thanks a lot. Appreciate it

  24. #24

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    295

    Re: [RESOLVED] highlight duplicate rows include original instance.

    Just one last thing, it creates the duplicates sheet, even when there are zero duplicates sometimes in the sheet. can we avoid created the duplicates sheet when there are no duplicates and show a msgbox. no duplicates found.

  25. #25
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: [RESOLVED] highlight duplicate rows include original instance.

    Code:
     rc = 1
    For Each rng In MyDic.Items
        x = x + 1
        Debug.Print rng.Address
        If rng.Areas.Count > 1 Or rng.Rows.Count > 1 Then
            if sht is nothing then
                Set sht = ws1.Parent.Sheets.Add
                sht.Name = "duplicates"
           end if
            For Each rw In rng.Rows
                sht.Cells(rc, 1).Resize(, rw.Columns.Count).Value = rw.Value
                sht.cells(rc,1).Offset(, rw.Columns.Count) = "dup" & x ' Compile Error: syntax error.
                rc = rc + 1
            Next
            rng.Delete xlShiftUp
        End If
    Next
    if sht is nothing then msgbox "No Duplicates Found"
    try this one
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

Tags for this Thread

Posting Permissions

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



Click Here to Expand Forum to Full Width