Dictionary request

emukiss10

Board Regular
Joined
Nov 17, 2017
Messages
201
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)
Code:
   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.
 
Last edited:

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
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?
 
Upvote 0
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.
 
Upvote 0
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.
 
Last edited:
Upvote 0
Give this a shot on a copy of your workbook:

Rich (BB code):
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
 
Upvote 0
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...
Code:
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)...
Code:
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.
 
Last edited:
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
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!
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,287
Members
448,562
Latest member
Flashbond

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top