VBA Dictionary and Array

[Mallesh23]

Hi Team,

I am Reading data into dictionary as a table, storing lookup value in array and then printing.

My Below code works , need one small change

Want to replace into Array
'Print Out Dictionary using loop in Range. it works
For Each cl In Range("D2", Range("d" & Rows.Count).End(xlUp))
cl.Offset(, 1).Value = .Item(cl.Value)
Next cl


'Store lookup value outcome in Array and print the result...... below piece of code needs correction.
Dim lrow As Long

For i = LBound(arr, 1) To UBound(arr, 1)
arr_Out(i, 1) = .Item(arr(i, 1))
Next i

lrow = UBound(arr_Out, 1)
Range("E2").Resize(lrow).Value = WorksheetFunction.Transpose(dict.Items)

Sub Dict_array()

    Dim dict As New Scripting.dictionary
    
    Dim arr As Variant
    Dim rg As Range
    
    Set rg = Range("A1").CurrentRegion
    Set rg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    arr = rg.Value
    
    Dim i As Long
    Dim cl As Range
    
    
    Dim arr_Out As Variant
    arr_Out = Range("d2:d5").Value
       
    With dict
        
        For i = LBound(arr, 1) To UBound(arr, 1)
            If Not .Exists(arr(i, 1)) Then
                .Add (arr(i, 1)), arr(i, 2)
            End If
        Next i
    
    'Print Out Dictionary using loop in Range. it works
    
        For Each cl In Range("D2", Range("d" & Rows.Count).End(xlUp))
                cl.Offset(, 1).Value = .Item(cl.Value)
        Next cl
    
    
    'Print Dictionary  store in Array and print
    Dim lrow As Long
           
        For i = LBound(arr, 1) To UBound(arr, 1)
                arr_Out(i, 1) = .Item(arr(i, 1))
        Next i
        
    lrow = UBound(arr_Out, 1)
    
    Range("E2").Resize(lrow).Value = WorksheetFunction.Transpose(dict.Items)

    
    End With

Below is table, Column AB Data, Column D is lookup Column. output is in Column E expecting.

Book1
	A	B	C	D	E
1	Name	Century		Name	Century
2	Sachin	50		Sachin
3	Dhoni	30		Dhoni
4	Sehwag	35		Sehwag
5	Gayle	40
Sheet1

End Sub

 

[Dermot]

Once you have filled the array arr_Out, you can write it to the sheet like this

Range("E2").Resize(lrow,1) = arr_Out

 

[Mallesh23]

Hi Dermot,

Thanks for your help, but I am unable to fill items in arr_out. finding it difficult.



Thanks
mg

 

[Mallesh23]

Hi Team,

I tried below code its working, but if look up value not found, it is putting same value.

Sub Dict_array()

    Dim dict As New Scripting.dictionary
    
    Dim arr As Variant
    Dim rg As Range
    
    Set rg = Range("A1").CurrentRegion
    Set rg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    arr = rg.Value
    
    Dim i As Long
    Dim cl As Range
    
    
    'Store in Dictionary
    With dict
        For i = LBound(arr, 1) To UBound(arr, 1)
            If Not .Exists(arr(i, 1)) Then
                .Add (arr(i, 1)), arr(i, 2)
            End If
        Next i
    
        
    'Store in Array and print
    Dim ary As Variant
    ary = Range("d2:D4").Value
   
      For i = LBound(ary, 1) To UBound(ary, 1)
         If .Exists(ary(i, 1)) Then
            ary(i, 1) = .Item(ary(i, 1))
         End If
      Next i
    

End With

Range("E2:E4").Value = ary

End Sub

Below is the output it is generating in Column E. E4 is giving wrong result.

Book1
	A	B	C	D	E
1	Name	Century		Name	Century
2	Sachin	50		Sachin	50
3	Dhoni	30		Dhoni	30
4	Sehwag	35		Mahi	Mahi
5	Gayle	40
Sheet1

 

[Mallesh23]

Hi Team,

Still my below code is not working, tried different combination giving below result.

Book1
	A	B	C	D	E
1	Name	Century		Name	Century
2	Sachin	50		Sachin	50
3	Dhoni	30		Dhoni	30
4	Sehwag	35		Mahi	Mahi
5	Gayle	40
Sheet1

Sub Dict_array()

    Dim dict As New Scripting.dictionary
    
    Dim arr As Variant
    Dim rg As Range
    
    Set rg = Range("A1").CurrentRegion
    Set rg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    arr = rg.Value
    
    Dim i As Long
    Dim cl As Range
    
    
    'Store in Dictionary
    With dict
        For i = LBound(arr, 1) To UBound(arr, 1)
            If Not .Exists(arr(i, 1)) Then
                .Add (arr(i, 1)), arr(i, 2)
            End If
        Next i
    
        
    'Store in Array and print
    Dim ary_output As Variant
    ary_output = Range("d2:D4").Value
   
      For i = LBound(ary_output, 1) To UBound(ary_output, 1)
         If .Exists(ary_output(i, 1)) Then
            ary_output(i, 1) = .Item(arr(i, 1))
         End If
      Next i
    

End With

Range("E2:E4").Value = ary_output

End Sub

Thanks
mg

 

[Peter_SSs]

Try making this change

For i = LBound(ary_output, 1) To UBound(ary_output, 1)
  If .Exists(ary_output(i, 1)) Then
    ary_output(i, 1) = .Item(arr(i, 1))
  End If
Next i

You need to replace the values in ary_output whether or not they exist in the dictionary.

 

[Mallesh23]

Hi Peter,

Thanks for your help, Column D is my look up Column.
your code worked but output should be links to Column D.


Below Code works, this piece of code I want to replace with Array.

'Print Out Dictionary using loop in Range. it works
For Each cl In Range("D2", Range("d" & Rows.Count).End(xlUp))
cl.Offset(, 1).Value = .Item(cl.Value)
Next cl



Thanks
mg

 

[Peter_SSs]

your code worked but output should be links to Column D.

It is linked to column D. What makes you think it is not?

I have not changed any linking, just stopped the code returning the name from column D if it is not in the dictionary so that in your example you don't get "Mahi" in E4

 

[Mallesh23]

Hi Peter,

Sorry my actual requirement was not clear. Below is the output I am getting ,

and my expected output mentioned at last.

'Output 1

 Dim ary_output As Variant
    ary_output = Range("D2:d5").Value
  
    For i = LBound(ary_output, 1) To UBound(ary_output, 1)
        If .Exists(ary_output(i, 1)) Then
          ary_output(i, 1) = .Item(arr(i, 1))
        End If
    Next i
    End With
   Range("e2:e5").Value = ary_output

Book1
	A	B	C	D	E
1	Name	Century		Name	Century
2	Sachin	50		Sachin	50
3	Dhoni	30		Dhoni	30
4	Sehwag	35		Mallesh	Mallesh
5	Gayle	40		Gayle	40
Sheet2

'Output 2

  Dim ary_output As Variant
    ary_output = Range("D2:d5").Value
  
    For i = LBound(ary_output, 1) To UBound(ary_output, 1)
       ' If .Exists(ary_output(i, 1)) Then
          ary_output(i, 1) = .Item(arr(i, 1))
        'End If
    Next i
    End With
   Range("e2:e5").Value = ary_output

Book1
	A	B	C	D	E
1	Name	Century		Name	Century
2	Sachin	50		Sachin	50
3	Dhoni	30		Dhoni	30
4	Sehwag	35		Ponting	35
5	Gayle	40		Gayle	40
Sheet1

Expected output

Book1
	A	B	C	D	E	F	G
1	Name	Century		Name	Century		=VLOOKUP(D2,$A$2:$B$5,2,0)
2	Sachin	50		Sachin	50
3	Dhoni	30		Dhoni	30
4	Sehwag	35		Ponting	#N/A		or Blank
5	Gayle	40		Gayle	40
Sheet1

Cell Formulas
Range	Formula
E2:E5	E2	=VLOOKUP(D2,$A$2:$B$5,2,0)

 

[Peter_SSs]

Does column E have any values (apart from the heading) before the code is run?
It was blank in your previous examples.

Even if column E does contain values, the code will replace them.

My sheet before code

Mallesh23 2020-07-26 1.xlsm
	A	B	C	D	E
1	Name	Century		Name	Century
2	Sachin	50		Sachin	50
3	Dhoni	30		Dhoni	30
4	Sehwag	35		Ponting	35
5	Gayle	40		Gayle	40
6
Sheet2

My code (I have tidied up a few unused bits and moved all the Dim statements to the top)

Sub Dict_array()
    Dim dict As New Scripting.dictionary
    Dim arr As Variant
    Dim rg As Range
    Dim i As Long
    Dim ary As Variant
   
    Set rg = Range("A1").CurrentRegion
    Set rg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    arr = rg.Value
   
    'Store in Dictionary
    With dict
        For i = LBound(arr, 1) To UBound(arr, 1)
            If Not .Exists(arr(i, 1)) Then
                .Add (arr(i, 1)), arr(i, 2)
            End If
        Next i
   
       'Store in Array and print
       ary = Range("d2:D4").Value
     
       For i = LBound(ary, 1) To UBound(ary, 1)
             ary(i, 1) = .Item(ary(i, 1))
       Next i
   
    End With
    Range("E2:E4").Value = ary
End Sub

My sheet after the above code

Mallesh23 2020-07-26 1.xlsm
	A	B	C	D	E
1	Name	Century		Name	Century
2	Sachin	50		Sachin	50
3	Dhoni	30		Dhoni	30
4	Sehwag	35		Ponting
5	Gayle	40		Gayle	40
6
Sheet2