Set data structure in VBA Set data structure in VBA vba vba

Set data structure in VBA


Take a look at .NET ArrayList, it has such methods as Add, Contains, Sort etc. You can instantiate the object within VBS and VBA environment:

Set ArrayList = CreateObject("System.Collections.ArrayList")

Scripting.Dictionary also may fit the needs, it has unique keys, Exists method allows to check if a key is already in the dictionary.

However, SQL request via ADODB probably will be more efficient for that case. The below examples shows how to retrieve unique rows via SQL query to the worksheet:

Option ExplicitSub GetDistinctRecords()    Dim strConnection As String    Dim strQuery As String    Dim objConnection As Object    Dim objRecordSet As Object    Select Case LCase(Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".")))        Case ".xls"            strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='" & ThisWorkbook.FullName & "';Mode=Read;Extended Properties=""Excel 8.0;HDR=YES;"";"        Case ".xlsm", ".xlsb"            strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source='" & ThisWorkbook.FullName & "';Mode=Read;Extended Properties=""Excel 12.0 Macro;HDR=YES;"";"    End Select    strQuery = "SELECT DISTINCT * FROM [Sheet1$]"    Set objConnection = CreateObject("ADODB.Connection")    objConnection.Open strConnection    Set objRecordSet = objConnection.Execute(strQuery)    RecordSetToWorksheet Sheets(2), objRecordSet    objConnection.CloseEnd SubSub RecordSetToWorksheet(objSheet As Worksheet, objRecordSet As Object)    Dim i As Long    With objSheet        .Cells.Delete        For i = 1 To objRecordSet.Fields.Count            .Cells(1, i).Value = objRecordSet.Fields(i - 1).Name        Next        .Cells(2, 1).CopyFromRecordset objRecordSet        .Cells.Columns.AutoFit    End WithEnd Sub

Source data should be placed on the Sheet1, the result is output to the Sheet2. The only limitation for that method is that ADODB connects to the Excel workbook on the drive, so any changes should be saved before query to get actual results.

If you want to get only the set of non-distinct rows, then the query should be as follows (just an example, you have to put your set of fields into query):

    strQuery = "SELECT CustomerID, CustomerName, ContactName, Address, City, PostalCode, Country FROM [Sheet1$] GROUP BY CustomerID, CustomerName, ContactName, Address, City, PostalCode, Country HAVING Count(*) > 1"


You could use a collection and do the following function, collections enforce unique key identifiers:

Public Function InCollection(Col As Collection, key As String) As Boolean  Dim var As Variant  Dim errNumber As Long  InCollection = False  Set var = Nothing  Err.clear  On Error Resume Next    var = Col.Item(key)    errNumber = CLng(Err.Number)  On Error GoTo 0  '5 is not in, 0 and 438 represent incollection  If errNumber = 5 Then ' it is 5 if not in collection    InCollection = False  Else    InCollection = True  End IfEnd Function


Simply write a wrapper for Scripting.Dictionary that exposes only set-like operations.

clsSet

Option ExplicitPrivate d As Scripting.DictionaryPrivate Sub Class_Initialize()    Set d = New Scripting.DictionaryEnd SubPublic Sub Add(var As Variant)    d.Add var, 0End SubPublic Function Exists(var As Variant) As Boolean    Exists = d.Exists(var)End FunctionPublic Sub Remove(var As Variant)    d.Remove varEnd Sub

And then you can use it like so:

mdlMain

Public Sub Main()    Dim s As clsSet    Set s = New clsSet    Dim obj As Object    s.Add "A"    s.Add 3    s.Add #1/19/2017#    Debug.Print s.Exists("A")    Debug.Print s.Exists("B")    s.Remove #1/19/2017#    Debug.Print s.Exists(#1/19/2017#)End Sub

Which prints True, False and False as expected.