Search code examples
sqlvbaexcelrecordset

How to select distinct values from one column in adodb recordset Excel VBA?


I have a ADODB.Recordset rs that I'm getting from DB. I have to reuse this recordset twice now.

This is sample of my Recordset:

Mike     Client
John     Manager
Karen    Client
Joe      Sub
Brian    Manager

Now I need to get all the titles, so I want to get:

Client
Manager
Sub

I know that there is rs.Filter, but I'm not sure if I can select distinct from it.

Also I know that I can clone this Recordset:

Dim rs_clone As ADODB.Recordset
Set rs_clone = New ADODB.Recordset
rs_clone = rs.getrows()

Is it possible to clone only distinct records? Or any better way? Thanks


Solution

  • Firing a sql string at the database gives you lots of room to be very selective about what you'd like returned

    Small example (using late binding which I prefer in production code) where I'm asking for a distinct list from the table column MyColumn

    Dim cn As Object
    Dim rs As Object
    
    Set cn = CreateObject("ADODB.Connection")
    cn.Open strConn
    cn.CommandTimeout = 0
    
    Set rs = CreateObject("ADODB.Recordset")
    Set rs.ActiveConnection = cn
    
    
    '=====================
    rs.Open "SELECT Distinct MyColumn AS C FROM myTable"
    

    strConn needs to be set to the correct connection string.


    EDIT

    Without being able to fire a sql string at the database with the help of this post vba: get unique values from array I've got the following solution.

    If you prefer early binding then references to the following will be required:

    • Microsoft ActiveX Data Objects (Im using 6.1 library)
    • Microsoft Scripting runtime (this is so we can use a dictionary)

    Code as follows:

    Option Explicit
    
    Global Const strConn As String = _
        "PROVIDER=MySQLprovider;" & _
        "P*SSWORD=MyPword;" & _
        "USER ID=MyLogin;" & _
        "INITIAL CATALOG=MyDB;" & _
        "DATA SOURCE=MyServer;" & _
        "USE PROCEDURE FOR PREPARE=1;" & _
        "AUTO TRANSLATE=True;"
    
    
    Sub getDistinctRecords()
    
    Dim cn As ADODB.Connection
    Set cn = New ADODB.Connection
    cn.ConnectionTimeout = 0
    cn.Open strConn
    
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    rs.ActiveConnection = cn
    
    '>>this mimics your record set with non-distinct members
    rs.Open _
        "SELECT 'a' as MyCol UNION ALL " & _
        "SELECT 'a' as MyCol UNION ALL " & _
        "SELECT 'b' as MyCol UNION ALL " & _
        "SELECT 'b' as MyCol"
    
    Dim Arr() As Variant
    Arr = rs.GetRows() 
    
    Dim d As Scripting.Dictionary
    Set d = New Scripting.Dictionary
    
    Dim i As Long
    For i = LBound(Arr, 2) To UBound(Arr, 2)
        d(Arr(0, i)) = 1
    Next i
    
    Dim v As Variant
    For Each v In d.Keys()
    
        '>>d.Keys() is a Variant array of the unique values in myArray.
        '>>v will iterate through each of them.
    
        '>>to print to the immediate window
        Debug.Print v
    Next v
    
    '=====================
         'tidy up connection
    On Error Resume Next
        Set rs.ActiveConnection = Nothing
    On Error GoTo 0
    
    If Not (rs Is Nothing) Then
        If (rs.State And 1) = 1 Then rs.Close
        Set rs = Nothing
    End If
    If Not (cn Is Nothing) Then
        If (cn.State And 1) = 1 Then cn.Close
        Set cn = Nothing
    End If
    
    End Sub