Eliminating Duplicate records

[Andrew Wilson]

Hello,
firstly let me say i am a complete newbie to posting in forums although i have used them often to point me in the right direction.

I Have an excel 2007 table that gets updated every time a user adds or amends a record in a database even if they only press save. i need to count the entries by each user to compare to another figure but to do this reliably i need to exclude those records that don't really contain any useful data i.e. user pressed save more that once for some reason.

i have columns for User, Update Date-Time, Enquiry Id, among others

so the logic would be; remove rows where user ID and Enquiry Id are the same and the difference in Update Date-Time is less than 5 minutes.

i have some knowledge of VBA although would prefer a solution that does not use it as this needs to be used by non VBA trained Staff.

any help would be great
thanks in advance

 

[hurgadion]

OK, I understand Your Problem, I think so... It is nontrivial problem to solve it using my Solution. I will think about a suitable Solution for Your interesting problem, best regards.

 

[hurgadion]

Hi, once again. Try to test a following Code:

Sub Eliminator()
Dim a&, i&, j&, x&, w As String
Dim tbl1(), tbl2(), tbl12(), tbl3()

Range("F:H").ClearContents
a = Cells(Rows.Count, 2).End(xlUp).Row

For i = 1 To a
  If i = 1 Then
    GoTo daley
  Else
     w = Cells(i, 2).Value & "_" & Cells(i, 3).Value
     If Not IsError(Application.Match(w, tbl12, 0)) Then
        For j = 1 To x
          If tbl12(j) = a Then
            If Not Abs(tbl3(j) - Cells(i, 4).Value) <= 1 / 24 / 60 * 5 Then
               x = x + 1
               GoTo daley
             End If
           End If
        Next j
      Else
        daley:
        x = x + 1
        ReDim Preserve tbl1(1 To x)
        ReDim Preserve tbl2(1 To x)
        ReDim Preserve tbl12(1 To x)
        ReDim Preserve tbl3(1 To x)
        tbl1(x) = Cells(i, 2).Value
        tbl2(x) = Cells(i, 3).Value
        tbl12(x) = tbl1(x) & "_" & tbl2(x)
        tbl3(x) = Cells(i, 4).Value
      End If
    End If
Next i

Cells(1, 6).Resize(x) = Application.Transpose(tbl1)
Cells(1, 7).Resize(x) = Application.Transpose(tbl2)
Cells(1, 8).Resize(x) = Application.Transpose(tbl3)
End Sub

I assume that Your Data there is in Columns B:D, best regards.

 

[Andrew Wilson]

hello I'm back
when i run this i get a Type Mismatch error on line
w = Cells(i, 2).Value & "_" & Cells(i, 3).Value

 

[hurgadion]

I don't know what is problem, in my WorkSheet the above Code works, best regards.

 

[Andrew Wilson]

I have pinned the problem down to some error values in the first column so now it runs fine, but does not remove any columns. when i get home i will upload an example with some real(ish) data and some of the duplicates i want to remove Highlighted.

 

[Andrew Wilson]

Whilst Hurgadion is very kind i wonder if anyone has any other proposed methods, perhaps more long winded but easier for a bear with a small brain to comprehend.

 

[hurgadion]

If it is possible, give me, please Your Example in a file and show me, please, the mistakes, best regards.

 

[Andrew Wilson]

https://docs.google.com/open?id=0B0Ojh1f2IgNfUFlKUHhvNUhVU2c
here is a sample of the data i am working with including the macro. i have highlighted in yellow 1 example of two records i would consider to be a duplicate of each other as the data in column 1 and 3 is the same and update time is less then 5 minutes different, i need to keep 1 (the first) of these rows and remove any others where the update time is less than 5 mins from the first.
this is just a sample, the actual data is 12 columns wide starting from column 2, so i will need to be able to expand the solution from 3 columns to 12. the other 9 columns do not need to be tested for duplication.

 

[hurgadion]

OK,
I introduced same correction in the Code. Now should be better... Try, please, using a Code:

Sub Eliminatorx()
Dim a&, i&, j&, x&, w As String
Dim tbl1(), tbl2(), tbl12(), tbl3()

Range("F:H").ClearContents
a = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To a
'For i = 1 To 530
  If i = 2 Then
    GoTo daley  
  Else
     w = Cells(i, 2).Value & "_" & Cells(i, 4).Value
     If Not IsError(Application.Match(w, tbl12, 0)) Then
        For j = 1 To x
          If tbl12(j) = w Then
            If Not Abs(tbl3(j) - Cells(i, 3).Value) <= 1 / 24 / 60 * 5 Then
               GoTo daley
             End If
           End If
        Next j
      Else
daley:
        x = x + 1
        ReDim Preserve tbl1(1 To x)
        ReDim Preserve tbl2(1 To x)
        ReDim Preserve tbl12(1 To x)
        ReDim Preserve tbl3(1 To x)
        tbl1(x) = Cells(i, 2).Value
        tbl2(x) = Cells(i, 4).Value
        tbl12(x) = tbl1(x) & "_" & tbl2(x)
        tbl3(x) = Cells(i, 3).Value
      End If
    End If
Next i

Cells(1, 6).Resize(x) = Application.Transpose(tbl1)
Cells(1, 7).Resize(x) = Application.Transpose(tbl3)
Cells(1, 8).Resize(x) = Application.Transpose(tbl2)
End Sub

Best regards.

 

[Andrew Wilson]

thanks for trying so hard, the code still does not remove row 10 from the sample data as a duplicate of row 9.
i have the same number of rows in each set after the code runs.
very best wishes
A