LOOKUP with VBA Dictionary & Arrays

[nmmounir]

Hello everyone,

I was trying to use dictionary along with arrays to perform a lookup but it is giving a run time error 5 : Invalid procedure call or argument.

However, when I write the code using dictionary without arrays, it works perfectly. below are the two codes. What am i doing wrong with the dictionary arrays combo?

Dictionary array combo (not working & giving the above error)

Dictionary without Array (working perfectly)

 

[offthelip]

Names is a varaint array so you need to use array address like this:

If Mydic.Exists(Names(i, 1)) = True Then

You need to change it on the next line too
It is very helpful to post your code as text enclosed by the VBA formatting , which allows responder to Edit your code rather than typing it in a fresh,

 

[nmmounir]

Names is a varaint array so you need to use array address like this:

If Mydic.Exists(Names(i, 1)) = True Then

You need to change it on the next line too
It is very helpful to post your code as text enclosed by the VBA formatting , which allows responder to Edit your code rather than typing it in a fresh,

Thank you for your reply.

I wrote the code as you mentioned but i got a run time error 13 type mismatch ! any idea why? here is the code below as text.

Sub lookupwith_Dictionary()

Sheet2.Activate
Dim Mydic As Dictionary
Dim list As Variant
Dim Names As Variant, Countryname As Variant

list = Range("M2", Range("M2").End(xlDown).End(xlToRight)).Value
Set Mydic = New Dictionary

Dim i As Long
For i = 1 To UBound(list, 1)
Names = list(i, 1)
Countryname = list(i, 2)
If Mydic.Exists(Names) = False Then
Mydic.Add Names, Countryname
End If
Next i

Names = Range("P2", Range("P2").End(xlDown)).Value
For i = 2 To UBound(Names)
Names = Names(i, 1)
If Mydic.Exists(Names(i, 1)) = True Then
Range("Q" & i).Value = Mydic(Names(i, 2))
End If
Next i

 

[nmmounir]

Names is a varaint array so you need to use array address like this:

If Mydic.Exists(Names(i, 1)) = True Then

You need to change it on the next line too
It is very helpful to post your code as text enclosed by the VBA formatting , which allows responder to Edit your code rather than typing it in a fresh,

Please ignore the previous macro. it is now working as per below.

Sub lookupwith_Dictionary()

Sheet2.Activate
Dim Mydic As Dictionary
Dim list As Variant
Dim Names As Variant, Countryname As Variant

list = Range("M2", Range("M2").End(xlDown).End(xlToRight)).Value
Set Mydic = New Dictionary

Dim i As Long
For i = 1 To UBound(list, 1)
    Names = list(i, 1)
    Countryname = list(i, 2)
    If Mydic.Exists(Names) = False Then
        Mydic.Add Names, Countryname
    End If
Next i

Dim row As Byte
row = 2
Names = Range("P2", Range("P2").End(xlDown)).Value
For i = LBound(Names) To UBound(Names)
    If Mydic.Exists(Names(i, 1)) = True Then
        Range("Q" & row).Value = Mydic(Names(i, 1))
        row = row + 1
    End If
Next i

End Sub

 

[Peter_SSs]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags in your last post for you this time.

 

[nmmounir]

Please ignore the previous macro. it is now working as per below.

Sub lookupwith_Dictionary()

Sheet2.Activate
Dim Mydic As Dictionary
Dim list As Variant
Dim Names As Variant, Countryname As Variant

list = Range("M2", Range("M2").End(xlDown).End(xlToRight)).Value
Set Mydic = New Dictionary

Dim i As Long
For i = 1 To UBound(list, 1)
    Names = list(i, 1)
    Countryname = list(i, 2)
    If Mydic.Exists(Names) = False Then
        Mydic.Add Names, Countryname
    End If
Next i

Dim row As Byte
row = 2
Names = Range("P2", Range("P2").End(xlDown)).Value
For i = LBound(Names) To UBound(Names)
    If Mydic.Exists(Names(i, 1)) = True Then
        Range("Q" & row).Value = Mydic(Names(i, 1))
        row = row + 1
    End If
Next i

End Sub

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags in your last post for you this time.

Thank you Peter. May you please how to use these code tags? I am not sure how you did this?

 

[nmmounir]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags in your last post for you this time.

Ok I will look it up and follow it.

 

[mumps]

Try:

Sub FillCountry()
    Application.ScreenUpdating = False
    Dim v1 As Variant, v2 As Variant, dic As Object, i As Long, x As Long, arr() As Variant, lRow As Long, Val As String
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v1 = Range("M2", Range("M" & Rows.Count).End(xlUp)).Resize(, 2).Value
    v2 = Range("P2", Range("P" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        Val = v1(i, 1)
        If Not dic.exists(Val) Then
            dic.Add Val, v1(i, 2)
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        If dic.exists(v2(i, 1)) Then
            Val = v2(i, 1)
            x = x + 1
            ReDim Preserve arr(1 To x)
            arr(x) = dic(Val)
        End If
    Next i
    Range("Q2").Resize(lRow - 1) = Application.Transpose(arr)
    Application.ScreenUpdating = True
End Sub

 

[nmmounir]

Try:

Sub FillCountry()
    Application.ScreenUpdating = False
    Dim v1 As Variant, v2 As Variant, dic As Object, i As Long, x As Long, arr() As Variant, lRow As Long, Val As String
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v1 = Range("M2", Range("M" & Rows.Count).End(xlUp)).Resize(, 2).Value
    v2 = Range("P2", Range("P" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        Val = v1(i, 1)
        If Not dic.exists(Val) Then
            dic.Add Val, v1(i, 2)
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        If dic.exists(v2(i, 1)) Then
            Val = v2(i, 1)
            x = x + 1
            ReDim Preserve arr(1 To x)
            arr(x) = dic(Val)
        End If
    Next i
    Range("Q2").Resize(lRow - 1) = Application.Transpose(arr)
    Application.ScreenUpdating = True
End Sub

This a great code. just one question as I am new to VBA Dictionary.
If dic.exists(v2(i, 1)) Then
Val = v2(i, 1)
arr(x) = dic(Val)
shouldn't Val = v2(i,2) ? since it is the second column where the country list is?

 

[mumps]

Val

refers to the key in the dictionary, which is the value of v2(i,1) and

dic(Val)

refers to the item in the dictionary, which is the value of v1(i,2).