• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Search for multiple duplicate

Not sure if this needs VBA or just excel statements.

Is it possible please to help to show exceptions, ( based on the following conditions), - to show employees who are possible duplicate expenses. The conditions are:

a) different staff (column a)
b) charge the same amount (column H) -
c) same currency (column I)
c)for the same expense type (column F)
d) for the same travel period (column D and E)

Please can we copy each combination of possible duplicates, (all data in the rows) to new tabs. From the example I made, we should have 2 tabs - one for flight exceptions and 1 for the meals.

or if that is not possible, maybe create a column for each exception type.
 

Attachments

  • Same Period - Same Amount- (1).xlsx
    13.5 KB · Views: 9
Hi - I added the thread to a previous reply and forgot to remove it.
I have now removed the other thread.
Please can you reply and help me to the thread above.
Many thanks
David.
 
Yes - You noticed same thing ... how to use 'previous version'?
Here one idea ... but You should have there something correct.
This version 'thinks' that maybe dates would be okay ...
... there are maybe more 'doubles' than You have marked or how?
> Ideas? ... Answers? ... Questions?
 

Attachments

  • david gabra.xlsb
    47.7 KB · Views: 4
Thanks- but that not what I needed.
I need some magic -(like a marco button) that will take all the possible exceptions based on all the below happening.

a) different staff (column a)
b) charge the same amount (column H) -
c) same currency (column I)
c)for the same expense type (column F)
d) for the same travel period (column D and E)

Please can we copy each combination of possible duplicates, (all data in the rows) to new tabs.

I have created a macro that will look for duplicate, but to make it manable , I need each group of exception to a new tab.

thanks.
 

Attachments

  • Multiple Duplicate Rows -V1.xlsx
    13.7 KB · Views: 8
Last edited:
It won't work that way neither!
I won't even open that file!
There should be something which is TRUE.
If You tried to search 'duplicates' ... no work!
If no clear rules then it's better to do manually and You could get results
... few weeks later, if lucky!
I can make a macro for You which 'seems to do something for few weeks'.
 
Hi
Please can you help me with a macro that will create and put each duplicate set in a new tab.
Duplicates based on the conditions of

1) charge the same amount (column H) -
2) same currency (column I)
3) for the same expense type (column F)
4) for the same travel period (column D and E)

Thanks
 
See if this is how you wanted, based on your first sample workbook.
Code:
Sub test()
    Dim a, i As Long, ii As Long, x As Range, w, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("sheet1").Cells(1).CurrentRegion
        a = .Value: Set x = .Rows(1)
        For i = 2 To UBound(a, 1)
            If Not dic.exists(a(i, 8)) Then
                Set dic(a(i, 8)) = CreateObject("System.Collections.ArrayList")
                dic(a(i, 8)).Add Array(a(i, 4), a(i, 5), a(i, 6), a(i, 9), i)
            Else
                For ii = 0 To .Item(a(i, 8)).Count - 1
                    If (a(i, 4) = dic(a(i, 8))(ii)(0)) * (a(i, 5) = dic(a(i, 8))(ii)(1)) _
                        * (a(i, 6) = dic(a(i, 8))(ii)(2)) * (a(i, 9) = dic(a(i, 8))(ii)(3)) Then
                        Set x = Union(x, .Rows(i), .Rows(dic(a(i, 8))(ii)(4)))
                    End If
                Next
            End If
        Next
    End With
    With Sheets.Add
        x.Copy .Cells(1): .Columns.AutoFit
    End With
End Sub
 
thanks, one pain point, is that is I had 300,000 lines, can we add a identifier so we know which duplicates are from which set of duplicates.
that would really help.
 
Refer to column K, it is a help column I added manually, and I would like it to be done automatically, so that I know which duplicates are from which set.
In the example, row, 2, 5, and 25 are all duplicates, so I would want them to have the same reference ((in my example I manually put 1),
and row 8, 14, and 18 are also all duplicates, so I would want then to have a the same reference, (in my example I manually put 2) and so on and on.
 

Attachments

  • Multiple Duplicate Rows -V3.xlsx
    13.7 KB · Views: 9
try
Code:
Sub test()
    Dim a, i As Long, ii As Long, x As Range, n As Long, w, flg As Boolean, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("sheet1").Cells(1).CurrentRegion
        .Columns("j:k").Offset(1).ClearContents
        a = .Value: Set x = .Rows(1)
        For i = 1 To UBound(a, 1)
            If Not dic.exists(a(i, 8)) Then
                Set dic(a(i, 8)) = CreateObject("System.Collections.ArrayList")
                dic(a(i, 8)).Add Array(a(i, 4), a(i, 5), a(i, 6), a(i, 9), i, 0)
            Else
                For ii = 0 To .Item(a(i, 8)).Count - 1
                    If (a(i, 4) = dic(a(i, 8))(ii)(0)) * (a(i, 5) = dic(a(i, 8))(ii)(1)) _
                        * (a(i, 6) = dic(a(i, 8))(ii)(2)) * (a(i, 9) = dic(a(i, 8))(ii)(3)) Then
                        If dic(a(i, 8))(ii)(5) < 1 Then
                            w = dic(a(i, 8))(ii): n = n + 1: w(5) = n
                            dic(a(i, 8)).RemoveAt ii
                            dic(a(i, 8)).Insert ii, w
                        End If
                        .Cells(i, 10).Resize(, 2).Value = Array("Duplicate row", dic(a(i, 8))(ii)(5))
                        .Cells(dic(a(i, 8))(ii)(4), 10).Resize(, 2).Value = Array("Duplicate row", dic(a(i, 8))(ii)(5))
                        Set x = Union(x, .Rows(i), .Rows(dic(a(i, 8))(ii)(4))): flg = True: Exit For
                    End If
                    If Not flg Then
                        dic(a(i, 8)).Add Array(a(i, 4), a(i, 5), a(i, 6), a(i, 9), i, 0)
                    End If
                Next
                flg = False
            End If
        Next
    End With
    With Sheets.Add
        x.Copy .Cells(1): .Columns.AutoFit
    End With
End Sub
 
Back
Top