Get array headers as dictionary


Since function getArrayHeadersAsDictionary uses some non-built VBA functions, they also must be included in your code for the function to work properly.

Otherwise the following error will occur: Compile error: Sub or Function not defined.

Required functions are listed below. You can get to each function's source code by clicking its name:

When adding the functions above to your VBA project, make sure you haven't done it before. If there are two different public functions with the same name in a single VBA project, the following compilation error is thrown: Compile error: Ambiguous name detected: function_name.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
'**********************************************************************************************************
' Name:                 getArrayHeadersAsDictionary
' Author:               mielk | 2014-09-20
'
' Description:          Function to create a dictionary with mapping of the given array's columns.
'                       Column header text is the key in the result dictionary and its index number is
'                       the value.
'
' Parameters:
'   arr                 Array which columns are to be returned.
'                       It must have two dimensions, it the given array has more or less dimensions, or
'                       if it is not an array at all, exception will be thrown.
'
'
' Returns:
'   Dictionary          Dictionary with map of the given array's columns.
'                       As a key column headers texts are used, and their column index numbers are used
'                       as a value.
'
'
' Exceptions:
'   NoArrayException                Thrown if parameter [arr] is not an array.
'   NotDefinedArrayException        Thrown if the given array has not been defined yet.
'   TooManyDimensionsException      Thrown if the given array has more than 2 dimensions.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2014-09-20        mielk       Function created.
'**********************************************************************************************************
Public Function getArrayHeadersAsDictionary(arr As Variant) As Object
    Const METHOD_NAME As String = "getArrayHeadersAsDictionary"
    '------------------------------------------------------------------------------------------------------
    Dim column As Long
    '------------------------------------------------------------------------------------------------------


    'Check if the given parameter [arr] is an array, if it has been already initialized and -------------|
    'if it has exactly two dimensions.                                                                  '|
    'If it is not an array, code is moved to the label NotArrayException.                               '|
    'If it is an array, but has not been initialized yet, code is moved to the label                    '|
    'NotDefinedArrayException.                                                                          '|
    'If it is an array, but has less or more than two dimensions, code is moved to the label            '|
    'TooManyDimensionsException.                                                                        '|
    If Not VBA.IsArray(arr) Then GoTo NotArrayException                                                 '|
    If Not isDefinedArray(arr) Then GoTo NotDefinedArrayException                                       '|
    If countDimensions(arr) <> 2 Then GoTo TooManyDimensionsException                                   '|
    '----------------------------------------------------------------------------------------------------|


    'Create new instance of Dictionary and set it searching mode as case insensitive. -------------------|
    Set getArrayHeadersAsDictionary = VBA.CreateObject("Scripting.Dictionary")                          '|
    getArrayHeadersAsDictionary.CompareMode = TextCompare                                               '|
    '----------------------------------------------------------------------------------------------------|


    'Iterate through all the columns in the given array and put their names and index numbers to --------|
    'the final Dictionary.                                                                              '|
    For column = LBound(arr, 1) To UBound(arr, 1)                                                       '|
        With getArrayHeadersAsDictionary                                                                '|
            If Not .Exists(arr(column, 1)) Then                                                         '|
                Call .add(arr(column, 1), column)                                                       '|
            End If                                                                                      '|
        End With                                                                                        '|
    Next column                                                                                         '|
    '----------------------------------------------------------------------------------------------------|




'==========================================================================================================
ExitPoint:
    Exit Function


'----------------------------------------------------------------------------------------------------------
NotArrayException:
    'Error handling for the case if the given parameter [arr] is not an array.
    GoTo ExitPoint


NotDefinedArrayException:
    'Error handling for the case if the given parameter [arr] is an array but it has not been
    'initialized yet.
    GoTo ExitPoint


TooManyDimensionsException:
    'Error-handling for case if the given parameter is an array but it has more than 2 dimensions.
    GoTo ExitPoint


End Function