Dictionary request

[emukiss10]

Hello Friends!

One of our Moderators - Fluff - is providing Dictinaries which speeds up everything beyond expectations.
Can You make for me a macro that will compare colums A,E,G and remove duplicates in this fashion?

ex.

IF A5, E5, G5 has the same values as A54321, E54321, G54321 and A99, E99, G99 Then leave only one instance of that record. (all in one sheet!)


A5 = 10, E5 = 100, G5 = PP1 / A54321 = 10, E54321 = 100, G54321 = PP1 / 99 = 10, E99 = 100, G99 = PP1


(fashion)

   Dim Cl As Range
   Dim v1 As String
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   
   Set Ws1 = Sheets(1)
   Set Ws2 = Sheets(2)
   With CreateObject("Scripting.dictionary")
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.count).End(xlUp))
         v1 = Cl.Value & Cl.Offset(, 3).Value
         If Not .Exists(v1) Then .Add v1, Cl.Offset(, 5).Offset(, 2).Value
      Next Cl
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.count).End(xlUp))
         v1 = Cl.Value & Cl.Offset(, 4).Value
         If .Exists(v1) Then Cl.Offset(, 10).Offset(, 3).Value = .Item(v1)
      Next Cl
   End With

I have working code made by myself (myself = slow) but I was wondering if it can be speedup by dictionaries.
Usually Im importing 28-31 text files to seperate sheets (for every day of month) and work on them. Each has between 500K-1.5M records.

Best regards
W.

 

[Eric W]

When you say "leave 1 record", do you want to delete the entire row that has the duplicates, or do you want to just move up the values from those 3 columns? Is there anything else in the other columns that needs to be kept?

 

[emukiss10]

remove entire row. Leave only 1 row with those values

 

[Eric W]

What columns do you need to keep? I wrote a macro that actually deletes the rows, but if you have a large number of rows to delete, it can take a long time. I believe it would be faster to save all the data, clear the sheet, then replace the non-duplicated rows.

 

[emukiss10]

I have data in columns from A to M, All cells are populated with some data. All are different data. I want to look for duplicated rows but not all values in row determines duplicate. IF A E G are the same the whole row is to be removed.

I have working macro for that but Id like to make it faster with dictionaries.

 

[Eric W]

Give this a shot on a copy of your workbook:

Sub DeleteDups()
Dim MyDict As Object, MyData As Variant, MySheet As Worksheet, MyOut() As Variant
Dim lr As Long, i As Long, MyKey As String, r As Long
    
    Set MySheet = Worksheets("Sheet2")
    
    lr = MySheet.Cells(Rows.Count, "A").End(xlUp).Row
    MyData = MySheet.Range("A1:M" & lr).Value
    Set MyDict = CreateObject("Scripting.Dictionary")
    r = 0
    ReDim MyOut(1 To lr, 1 To 13)
    
    For i = 1 To UBound(MyData)
        MyKey = MyData(i, 1) & "|" & MyData(i, 5) & "|" & MyData(i, 7)
        If Not MyDict.exists(MyKey) Then
            r = r + 1
            For j = 1 To 13
                MyOut(r, j) = MyData(i, j)
            Next j
            MyDict.Add MyKey, 1
        End If
    Next i
    Debug.Print r
    
    MySheet.Range("A1").Resize(lr, 13) = MyOut
    
End Sub

 

[Rick Rothstein]

It is not clear to me where you want the output to be located. If you want it to be on the same sheet as your data starting in the same cell, then this one-liner should do it...

Sub RemoveDuplicateTripletsAEG()
  Range("A1").CurrentRegion.RemoveDuplicates Array(1, 5, 7), xlNo
End Sub

If, on the other hand, you want the output to go to another sheet (I'll use Sheet 2 for example purposes)...

Sub RemoveDuplicateTripletsAEG()
  Range("A1").CurrentRegion.Copy Sheets("Sheet2").Range("A1")
  Sheets("Sheet2").Range("A1").CurrentRegion.RemoveDuplicates Array(1, 5, 7), xlNo
End Sub

The above codes have assumed you are running the macro with the data sheet active. If that is not the case, then you will have to preface the unreferenced ranges with a reference to the data sheet they are on.

 

[emukiss10]

Thank You for replays.

Rick, I just want to remove rows that has the same values in 3 cells at once.

No copying or cuting. Just delete. Im looking for fastest way because my "work" hardware is slow.

 

[Rick Rothstein]

Thank You for replays.

Rick, I just want to remove rows that has the same values in 3 cells at once.

No copying or cuting. Just delete. Im looking for fastest way because my "work" hardware is slow.

Did you try the first code that I posted?

 

[emukiss10]

Yes, and its quite fast but I need to test it on monday at work. Ive just tested it at home with heavy eq.
Thank You for Your help!