Filtering Duplicate Rows based also on a variable condition.

[veridex]

Hi Mr. Excel.

I have a problem with duplicate entries in large spreadsheets. Like so many of us do really.

I need to filter out the duplicate entries based on a criteria over 11 days.

So basically any duplicate which reappears on the sheet which is older than 11 days needs to be removed from the sheet and placed on a different sheet.

I would like to get the extracted entries on a new sheet in the same workbook.

This has been boggling me for weeks now and up untill now I filter one by one by hand..

You can understand my frustration when I have deadlines to make..

The sheets are as follows. kind off..

The number and XXX represent column 1
Name and 111 represent column 2
Days and 5 represent column 3
more colums represent columns 4,5,6, etc.

NUMBER NAME DAYS
xxx 111 5 more colums
xxx 111 10 more colums
xxx 111 15 more colums
yyy 222 8 more colums

zzz 333 34 more colums

zzz 333 35 more colums

zzz 333 38 more colums

aaa 444 13 more colums

aaa 444 22 more colums

aaa 444 55 more colums

bbb 555 15 more colums

ccc 666 7 more colums

ccc 666 12 more colums

ccc 666 22 more colums


Many thanks for your help in advance.

 

[agihcam]

Hi -
Welcome to Mr. Excel Board
that means you need to delete when columnA and columnB have duplicates against the record and columnC > 11?

 

[jindon]

make a back-up copy first and try

Sub test()
Dim a, i As Long, ii As Long, dups(), uniq(), n As Long, t As Long, z As String
With Range("a1").CurrentRegion
   a = .Value
   ReDim dups(1 To .Rows.Count, 1 To .Columns.Count)
   ReDim uniq(1 To .Rows.Count, 1 To .Columns.Count)
   .Clear
End With
With CreateObject("Scripting.Dictionary")
   .CompareMode = vbTextCompare
   For i = 1 To UBound(a,1)
      z = a(i,1) & ";" & a(i,2)
      If Not .exists(z) Then
         n = n + 1
         For ii = 1 To UBound(a,2)
            uniq(n,ii) = a(i,ii)
         Next
         .add z, Nothing
      Else
         t = t + 1
         For ii = 1 To UBound(a,2)
            dups(t,ii) = a(i,ii)
         Next
      End If
   Next
End With
Erase a
Range("a1").Resize(n,UBound(uniq,2)).Value = uniq
On Error Resume Next
Sheets("Dups").Delete
On Error GoTo 0
Sheets.Add.Name="Dups"
Sheets("Dups").Range("a1").Resize(t,UBound(dups,2)).Value = dups
End Sub

 

[veridex]

Its worked!!

Many thanks,

It worked.