Hash table / associative array in VBA

Question

I cannot find documentation explaining how to create a hash table or associative array in VBA. Is it possible?

Can you link to an article or even better publish code?

Answer 1

I think you are looking for a Dictionary object found in the Microsoft Scripting Runtime library. (Add a link to your project from the Tools ... References list in VBE.)

It works pretty much with any simple value that can fit into a variant (Keys cannot be arrays, and trying to make their objects doesn't make much sense. See the comment from @Nile below.):

Dim d As dictionary Set d = New dictionary d("x") = 42 d(42) = "forty-two" d(CVErr(xlErrValue)) = "Excel #VALUE!" Set d(101) = New Collection 

You can also use the VBA Collection object if your needs are simpler and you just need string keys.

I don’t know if the hashes really are on anything, so you may need to dig further if you need a hash table. (EDIT: Scripting.Dictionary uses a hash table inside.)

Answer 2

I used the Francesco Balena HashTable class several times in the past when a compilation or dictionary was not perfect and I just needed a HashTable.

Answer 3

Try using a Dictionary object or a Collection object.

http://visualbasic.ittoolbox.com/documents/dictionary-object-vs-collection-object-12196

Answer 4

Here we go ... just copy the code into the module, it is ready to use

 Private Type hashtable key As Variant value As Variant End Type Private GetErrMsg As String Private Function CreateHashTable(htable() As hashtable) As Boolean GetErrMsg = "" On Error GoTo CreateErr ReDim htable(0) CreateHashTable = True Exit Function CreateErr: CreateHashTable = False GetErrMsg = Err.Description End Function Private Function AddValue(htable() As hashtable, key As Variant, value As Variant) As Long GetErrMsg = "" On Error GoTo AddErr Dim idx As Long idx = UBound(htable) + 1 Dim htVal As hashtable htVal.key = key htVal.value = value Dim i As Long For i = 1 To UBound(htable) If htable(i).key = key Then Err.Raise 9999, , "Key [" & CStr(key) & "] is not unique" Next i ReDim Preserve htable(idx) htable(idx) = htVal AddValue = idx Exit Function AddErr: AddValue = 0 GetErrMsg = Err.Description End Function Private Function RemoveValue(htable() As hashtable, key As Variant) As Boolean GetErrMsg = "" On Error GoTo RemoveErr Dim i As Long, idx As Long Dim htTemp() As hashtable idx = 0 For i = 1 To UBound(htable) If htable(i).key <> key And IsEmpty(htable(i).key) = False Then ReDim Preserve htTemp(idx) AddValue htTemp, htable(i).key, htable(i).value idx = idx + 1 End If Next i If UBound(htable) = UBound(htTemp) Then Err.Raise 9998, , "Key [" & CStr(key) & "] not found" htable = htTemp RemoveValue = True Exit Function RemoveErr: RemoveValue = False GetErrMsg = Err.Description End Function Private Function GetValue(htable() As hashtable, key As Variant) As Variant GetErrMsg = "" On Error GoTo GetValueErr Dim found As Boolean found = False For i = 1 To UBound(htable) If htable(i).key = key And IsEmpty(htable(i).key) = False Then GetValue = htable(i).value Exit Function End If Next i Err.Raise 9997, , "Key [" & CStr(key) & "] not found" Exit Function GetValueErr: GetValue = "" GetErrMsg = Err.Description End Function Private Function GetValueCount(htable() As hashtable) As Long GetErrMsg = "" On Error GoTo GetValueCountErr GetValueCount = UBound(htable) Exit Function GetValueCountErr: GetValueCount = 0 GetErrMsg = Err.Description End Function 

For use in VB (A) application:

 Public Sub Test() Dim hashtbl() As hashtable Debug.Print "Create Hashtable: " & CreateHashTable(hashtbl) Debug.Print "" Debug.Print "ID Test Add V1: " & AddValue(hashtbl, "Hallo_0", "Testwert 0") Debug.Print "ID Test Add V2: " & AddValue(hashtbl, "Hallo_0", "Testwert 0") Debug.Print "ID Test 1 Add V1: " & AddValue(hashtbl, "Hallo.1", "Testwert 1") Debug.Print "ID Test 2 Add V1: " & AddValue(hashtbl, "Hallo-2", "Testwert 2") Debug.Print "ID Test 3 Add V1: " & AddValue(hashtbl, "Hallo 3", "Testwert 3") Debug.Print "" Debug.Print "Test 1 Removed V1: " & RemoveValue(hashtbl, "Hallo_1") Debug.Print "Test 1 Removed V2: " & RemoveValue(hashtbl, "Hallo_1") Debug.Print "Test 2 Removed V1: " & RemoveValue(hashtbl, "Hallo-2") Debug.Print "" Debug.Print "Value Test 3: " & CStr(GetValue(hashtbl, "Hallo 3")) Debug.Print "Value Test 1: " & CStr(GetValue(hashtbl, "Hallo_1")) Debug.Print "" Debug.Print "Hashtable Content:" For i = 1 To UBound(hashtbl) Debug.Print CStr(i) & ": " & CStr(hashtbl(i).key) & " - " & CStr(hashtbl(i).value) Next i Debug.Print "" Debug.Print "Count: " & CStr(GetValueCount(hashtbl)) End Sub