VBA Help - dictionary highlight new Entry

[Mallesh23]

Hi Team,

I am comparing two list and bringing Unique values.
I am able to get output of unique keys, But how to get Dictionary Items of that unique key as well. Thanks

I am storing data into Array as my data are different workbooks.


Below attempted code, gives correct unique keys except Items, how to get it.

Sub Dictionary_Find_New_Entry()
    
    ary_Compare = Range("f2:f4").Value2
    ary_base = Range("A2:b5").Value2
    
        
    Dim dict As New Scripting.Dictionary
    Dim i As Long
    
    
     With dict
            .CompareMode = TextCompare
            For i = LBound(ary_base) To UBound(ary_base)
                .Item(ary_base(i, 2)) = "Empty"
                   If .Item(ary_base(i, 2)) <> "" Then
                      If Not .Exists(ary_base(i, 2)) Then
                            .Add (ary_base(i, 2)), (ary_base(i, 1))
                        End If
                    End If
            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
    
    Range("J1").value =  dict.Keys(0)  ' Giving correct output :=> Goods damaged in Transit
    
    Range("I1").value dict.Items(0)   :=> should give [B]37133[/B]
    

End Sub

Below is a Table , expected output I & j Columns

Book2
	A	B	C	D	E	F	G	H	I	J
1	Invoice no	Comments				Comment			Expected Output	Key-Dictionary
2	14656	Goods in Wareshouse				Goods in Wareshouse			37133	Goods damaged in Transit
3	27524	Goods Returned				goods Returned
4	37133	Goods damaged in Transit				Goods Sold
5	23427	Goods Sold
Sheet1

Thanks
mg

 

[Mallesh23]

Hi Fluff and Yongle,

Wow it worked!

Millions of thanks both of you for help, It has saved my lot of further work. ?


Thanks
mg

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[Mallesh23]

Hi Fluff,

There is a small change from client side, they want all unique comments with invoice. Even duplicate also.
Below is a Table , Compare column F to Column B. Collate all unique comments with invoice duplicate Comments also.

Expected output is in Column I and J. is it possible to get output by modifying existing code in dictionary.

Thanks in advance for help.

Book1
	A	B	C	D	E	F	G	H	I	J
1	Invoice no	Comments				Comment Criteria			Expected Output	Key-Dictionary
2	14656	Goods in Wareshouse				Goods in Wareshouse			37133	Goods damaged in Transit
3	27524	Goods Returned				goods Returned			78909	Goods damaged in Transit
4	37133	Goods damaged in Transit				Goods Sold			80979	Goods damaged in Transit
5	23427	Goods Sold							9797	Goods Stolen
6	78909	Goods damaged in Transit
7	80979	Goods damaged in Transit
8	9797	Goods Stolen
Sheet1

My Attempted CODE

Sub Dictionary_Find_New_Entry()
    
    ary_Compare = Range("f2:f4").Value2
    ary_base = Range("A2:b8").Value2
    
        
    Dim dict As New Scripting.Dictionary
    Dim i As Long
    
    
     With dict
            .CompareMode = TextCompare
            For i = LBound(ary_base) To UBound(ary_base)
                   If .Item(ary_base(i, 1)) <> "" Then
                      If Not .Exists(ary_base(i, 1)) Then   'same code above changed item and key.
                            .Add (ary_base(i, 1)), (ary_base(i, 2))
                        End If
                    End If
            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
    
    'Range("J2").value = dict.Keys(0)   ' Giving correct output :=> Goods damaged in Transit
    Range("J2").value = dict.Items(0)
    

End Sub

Thanks
mg

 

[Mallesh23]

Hi Fluff,

I tried with below code it is giving correct output.
But I am using Double dictionary here,

Can we get output using Dictionary. Just for learning purpose. Thanks.

Sub Dictionary_Find_New_Entry()
    
    ary_compare = Range("f2:f4").Value2
    ary_base = Range("A2:b8").Value2
    
        
    Dim dict As New Scripting.Dictionary
    Dim Dict2 As New Scripting.Dictionary
    
    Dim i As Long
    
    'Store Column F Unique values
     With dict
          .CompareMode = TextCompare
            For i = LBound(ary_compare) To UBound(ary_compare)
                If Not .Exists(ary_compare(i, 1)) Then
                    .Add ary_compare(i, 1), Empty
                End If
            Next i
     End With
     
     'Compare and Add new key's and Items in dictionary
        With Dict2
             .CompareMode = TextCompare
            For i = LBound(ary_base) To UBound(ary_base)
                      If Not (dict.Exists(ary_base(i, 2))) Then
                           Dict2.Add (ary_base(i, 1)), (ary_base(i, 2))
                        End If
            Next i
        End With


Range("M2").Resize(Dict2.Count).Value = Application.Transpose(Dict2.Keys)
Range("N2").Resize(Dict2.Count).Value = Application.Transpose(Dict2.Items)

'Below code works
'For i = 0 To Dict2.Count - 1
'    Range("M" & 2 + i).Value = Dict2.Keys(i)
'    Range("N" & 2 + i).Value = Dict2.Items(i)
'
'Next i

End Sub

Thanks
mg