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