VBA Dictionary - Compare two Columns and extract unique

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
840
Office Version
  1. 2010
Platform
  1. Windows
Hi Team,

I have two list of transaction ID. Compare it and Extract Unique Values.

Column A , Old list of transaction ID
Column B , New list of transaction ID


Colum C is a expected output. how to extract using Unique values using dictionary or any other method. Thanks.

Below is Table with expected output. Thanks.

Book6
ABC
1Old Transaction IDNew Transaction IDUnique Data
2111731117311246
3111751117511239
4111831118311247
5111851118511260
6112151121511257
7112171121711257
8112251124611259
91123111239
1011247
1111185
1211260
1311257
1411183
1511257
1611259
1711231
Sheet1


Thanks
mg
 

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,116
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub Mallesh()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Empty
      Next Cl
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then .Remove Cl.Value
      Next Cl
      Range("C2").Resize(.Count).Value = Application.Transpose(.Keys)
   End With
End Sub
 

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
840
Office Version
  1. 2010
Platform
  1. Windows
Hi Fluff,

Wow! What a beautiful piece of Code ,
It worked as expected, thanks a lot for your help !!! (y)🕺


Thanks
mg
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,116
Office Version
  1. 365
Platform
  1. Windows
Glad to help & thanks for the feedback.
 

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
840
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Hi Fluff,

One more help needed in this Example.
Compare two Columns and extract adjacent Columns cells value as well.

Below Code Puts output in G Columns , how to extract B and D Columns data into F and H.

VBA Code:
Sub CompareTwoColumns_Extract_Unique()
  
   Dim ary_base As Variant
   Dim ary_Compare As Variant
  
   'Store two Columns into Array
   ary_base = Sheet3.Range("C2", Range("C" & Rows.Count).End(xlUp)).Value2
   ary_Compare = Sheet3.Range("a2", Range("a" & Rows.Count).End(xlUp)).Value2
  
   'Store Unique value into Dictionary calling Function
   Dim dict_output As Dictionary
   Set dict_output = Compare2List(ary_base, ary_Compare)
  
   'Print Dict Unique Keys
    Range("G2").Resize(dict_output.Count).Value = Application.Transpose(dict_output.Keys)
     
        
End Sub

Public Function Compare2List(ByRef ary_base As Variant, ary_Compare As Variant) As Dictionary

    Dim i As Long
    Dim dict As New Scripting.Dictionary

     With dict
           
            For i = LBound(ary_base) To UBound(ary_base)
                .Item(ary_base(i, 1)) = Empty
            Next i
           
            For i = LBound(ary_Compare) To UBound(ary_Compare)
                If .exists(ary_Compare(i, 1)) Then .Remove (ary_Compare(i, 1))
            Next i
   
    End With
       

    Set Compare2List = dict

End Function


Below is Table and Expected output in Range("F:H")

Book3
ABCDEFGH
1Old Transaction IDPost DateNew Transaction IDTransaction DatePost DateNew Transaction IDTransaction Date
21117310/08/20201117310/08/202016/08/20201124611/08/2020
31117514/08/20201117514/08/202018/08/20201123910/08/2020
41118306/08/20201118306/08/202009/08/20201124709/08/2020
51118509/08/20201118509/08/202023/08/20201126013/08/2020
61121508/08/20201121508/08/202011/08/20201125711/08/2020
71121711/08/20201121711/08/202001/08/20201125909/08/2020
81122516/08/20201124611/08/2020
91123118/08/20201123910/08/2020
1009/08/20201124709/08/2020
1112/08/20201122512/08/2020
1223/08/20201126013/08/2020
1311/08/20201125711/08/2020
1411/08/20201118311/08/2020
1507/08/20201125909/08/2020
1609/08/20201123109/08/2020
Sheet3



Thanks
mg
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,116
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub Mallesh()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("c2", Range("c" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, -1).Resize(, 3)
      Next Cl
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then .Remove Cl.Value
      Next Cl
      Range("j2").Resize(.Count, 3).Value = Application.Index(.items, 0, 0)
   End With
End Sub
 

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
840
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Hi Fluff,

Thanks again for your help, giving correct output as per my question.

One more Last question if there are Non - Contiguous Columns and I want to add 5 Columns into Dictionary Items.

How to add 5 Non - Contiguous columns data into Dictionary Items. and Print keys and Items.

for example:=>
.Item(Cl.Value) = Array (Cl.Offset(, -1),Cl.Offset(, 2),Cl.Offset(, 3),Cl.Offset(, 5)))

and how to print same as output. Thanks.



Thanks
mg
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,116
Office Version
  1. 365
Platform
  1. Windows
Just change the resize on the output from 3 to 4 columns
 

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
840
Office Version
  1. 2010
Platform
  1. Windows
Hi Fluff,

sorry for late on this, Output of expected Columns are not in sequence, I am not getting desired result.

Expected Result are in Column GHI,

Macro's output which is in KLM Column , which is not matching with Expeced Columns("G:I:").value


Need minor change, But I am unable to Identify it. Thanks.


VBA Code:
Sub Mallesh()
   Dim Cl As Range
  
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("c2", Range("c" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Array(Cl.Offset(, -1), Cl.Offset(, 2))
         '.Item(Cl.Value) = Cl.Offset(, -1).Resize(, 3)
      Next Cl
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then .Remove Cl.Value
      Next Cl
      Range("K2").Resize(.Count, 3).Value = Application.Index(.items, 0, 0)
   End With
End Sub

Below is input and expected output

Book2
ABCDEFGHIJKLM
1Old Transaction IDPost DateNew Transaction IDDummy dataTransaction DatePost DateNew Transaction IDTransaction DatePost DateNew Transaction IDTransaction Date
21117310/08/202011173xxx10/08/202016/08/20201124611/08/202016/08/202044143#N/A
31117514/08/202011175xxx14/08/202018/08/20201123910/08/202018/08/202044112#N/A
41118306/08/202011183xxx06/08/202009/08/20201124709/08/202008/09/202044082#N/A
51118509/08/202011185xxx09/08/202023/08/20201126013/08/202023/08/202013/08/2020#N/A
61121508/08/202011215xxx08/08/202011/08/20201125711/08/202008/11/202044143#N/A
71121711/08/202011217xxx11/08/202007/08/20201125909/08/202008/07/202044082#N/A
81122516/08/202011246xxx11/08/2020
91123118/08/202011239xxx10/08/2020
1009/08/202011247xxx09/08/2020
1112/08/202011225xxx12/08/2020
1223/08/202011260xxx13/08/2020
1311/08/202011257xxx11/08/2020
1411/08/202011183xxx11/08/2020
1507/08/202011259xxx09/08/2020
1609/08/202011231xxx09/08/2020
Sheet1


Thanks
mg
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,116
Office Version
  1. 365
Platform
  1. Windows
You've only got 2 values in the item, which is why you get #N/A.
If you want the date, you will have to add it to the item.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,914
Messages
5,598,840
Members
414,261
Latest member
KatieBsc

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
Top