Multiple Dictionaries Or One Dictionary

Hi all,

Using Excel 2007.

I have 4 lists Parts, Category, Country, Class
I need to load a string, split the substring into array, loop the array to search dictionary(ies) to assign each element to the correct array.

What would be best approach in term of the dictionary(ies)

Thx
w

Would be better to upload a wb and to show your expected results.

Thanks Mike,

Can I add a dictionary to an array
I'm getting a subscript out of range error
Seem like the code should work

Thanks
w

Option Explicit
Option Base 1


Sub LoadDictionaries()
    '
    'Purpose:
    'Load Dictionaries
    '
    'References:
    '---------------------------------------------
    'Tools >> References >> Microsoft Scripting Runtime
    
    'Resources:
    '---------------------------------------------
    '
    'Date         Developer       Action
    '---------------------------------------------
    '12/14/2012   ws              Created

    'Initilialize
     With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
     End With
     
    'Declare variables
     Dim wb As Workbook
     Dim ws As Worksheet
     Dim dic() As Dictionary
     Dim i As Integer, j As Integer, k As Integer, x As Integer, y As Integer
     Dim lRows As Long
     
    'Intialize variables
     x = 1
    
    'Object reference
     Set wb = ThisWorkbook
     
    'Count number of sheets with dictionary entries
     For Each ws In wb.Worksheets
        If Left$(ws.Name, 1) = "d" Then
            i = i + 1
        End If
     Next ws
     
    'Load dictionaries from worksheets
    'Assume data starts in $A$1 on each worksheet
    'In the dictionary pairs below, the key comes first, the item comes second
    
     For Each ws In wb.Worksheets
        If Left$(ws.Name, 1) = "d" Then
            lRows = ws.Cells(Rows.Count, 1).End(xlUp).Row 'Last row
            Set dic(x) = New Dictionary
                For k = 1 To lRows
                    dic(x).Add ws.Cells(k, 1), ws.Cells(k, 2)
                Next k
            x = x + 1
        End If
     Next ws
                    
     For y = 1 To x
        Debug.Print dic(y).Count;
     Next y


'Tidy up
    'Erase arrays
     Erase dic()
     
    'Destroy objects
     Set wb = Nothing

    'Excel environment
     With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
     End With
     
End Sub

Give this a try

Option Explicit
Option Base 1


Sub LoadDictionaries()
    '
    'Purpose:
    'Load Dictionaries
    '
    'References:
    '---------------------------------------------
    'Tools >> References >> Microsoft Scripting Runtime
    
    'Resources:
    '---------------------------------------------
    '
    'Date         Developer       Action
    '---------------------------------------------
    '12/14/2012   ws              Created

    'Initilialize
     With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
     End With
     
    'Declare variables
     Dim wb As Workbook
     Dim ws As Worksheet
     Dim dic As Scripting.Dictionary
     Dim i As Long, j As Long, k As Long, y As Long
     Dim lRows As Long
     Dim x As Variant
     
    'Intialize variables
     x = 1
    
    'Object reference
     Set wb = ThisWorkbook
     
    'Count number of sheets with dictionary entries
     For Each ws In wb.Worksheets
        If Left$(ws.Name, 1) = "d" Then
            i = i + 1
        End If
     Next ws
     
    'Load dictionaries from worksheets
    'Assume data starts in $A$1 on each worksheet
    'In the dictionary pairs below, the key comes first, the item comes second
     Set dic(x) = New Scripting.Dictionary 'Set your dictionary ouside the loop
     For Each ws In wb.Worksheets
        If Left$(ws.Name, 1) = "d" Then
            lRows = ws.Cells(Rows.Count, 1).End(xlUp).Row 'Last row
            For k = 1 To lRows
                dic(ws.Cells(k, 1)) = ws.Cells(k, 2)
            Next k
        End If
     Next ws
     
     x = dic.Items
     For y = 0 To UBound(x)
        Debug.Print x(y)
     Next y


'Tidy up
    'Erase arrays

     
    'Destroy objects
     Set wb = Nothing

    'Excel environment
     With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
     End With
     
End Sub

Thanks Mike,

That does not appear to add multiple dictionaries, which is fine - except, how do I know the class of an item if I do not know which dictionary it cam from?
My thought was

• Grab element from array avItem(j,i)
  Search dic(1) if found then item is in Class Country
  Assign to avCountry()
  Else search dic(2)
  If found then item is in class Customer
  Assign to avCustomer()
  Else search dic(3)
  If found then item is in class Part
  Assign to avPart()
  Else search dic(4)
  If found then item is in class Date
  Assign to avDate()
  Else
  Not found print avItem(j,i) #FileNum

Is that doable?
Is there a better way?
thx
w

Thanks Jindon,

It will take me some time to digest your code.
I've used VBA for awhile, I've never used the dictionary object.

thx
w

Give you the idea.

     Dim dic As Object, ws As worksheet, i as long
     Set dic = Createobject("Scripting.Ditionary")
     For Each ws In wb.Worksheets
        If Left$(ws.Name, 1) = "d" Then
	    Set dic(ws.Name) = Createobject("Scripting.Ditionary") '<- dictionary on dictionay
            For i = 1 To ws.Cells(Rows.count, 1).End(xlUp).Row
                dic(ws.Name)(ws.Cells(i, 1).Value) = ws.Cells(i, 2).Value
            Next
        End If
     Next ws

So, Main dictionary holds worksheet.names and each item holds its own Dictionary.