Public Sub testDictSpeed()
On Error Resume Next
    Dim vData As Variant, iRow As Long, iCol As Long
    Dim lastRowId As Long, lastColId As Long
    Dim pDict As New Collection, vItem As Long
    Dim t As Single, pSheet As Worksheet
    
    t = Timer
    Set pSheet = ActiveSheet
    lastRowId = 1000000: lastColId = 8
    vData = pSheet.Range("A2:H1000001").Value
    For iCol = 1 To lastColId
        For iRow = 1 To lastRowId
            vItem = vData(iRow, iCol)
            pDict.Add vItem, CStr(vItem)
        Next
    Next
    MsgBox "time " & CStr(Timer - t) & " uniques " & CStr(pDict.Count)
End Sub

Public Sub testSql2Speed()
    Dim pSheet As Worksheet, sOut As String
    Dim pConn As New ADODB.Connection, i As Long
    Dim fso As New Scripting.FileSystemObject
    Dim pStream As Scripting.TextStream, t As Single
    Dim pData As New MSForms.DataObject, pRSet As New ADODB.Recordset
    t = Timer
    Set pStream = fso.CreateTextFile("C:\Path\db.txt", True)
    Set pSheet = ActiveSheet
    pStream.WriteLine "f1"
    For i = 1 To 8
        pSheet.Range(pSheet.Cells(2, i), pSheet.Cells(1000001, i)).Copy
        pData.GetFromClipboard
        pStream.Write pData.GetText(1)
    Next
    pStream.Close: Set pStream = Nothing
    pConn.Open "Driver=Microsoft Access Text Driver (*.txt, *.csv);Dbq=C:\Path\;Extensions=asc,csv,tab,txt;"
    pRSet.Open "Select Distinct f1 From [db.txt]", pConn, adOpenStatic, adLockReadOnly
    pRSet.MoveLast
    MsgBox "time " & CStr(Timer - t) & " uniques " & CStr(pRSet.RecordCount)
    pRSet.Close: pConn.Close
End Sub