How to consolidate similar entries in a sorted list without output to a worksheet using VBA/Excel

Question

I have an array which stores it\'s values in a sorted list. I have been using this sorted list to organise data, by date in several other spreadsheets.

My source dat

Answer 1

Using ADO, it is possible to treat an Excel workbook as a database, and issue SQL statements against it.

(I had trouble with periods in the field name, so I changed No. Pieces to Number of Pieces in the original data. Thanks @ThomasInzina.)

SELECT [Delivered to:], 
    COUNT(*) AS NumberOfDeliveries, 
    SUM([Number of Pieces:]) AS NumberOfPieces,
    SUM([Weight:]) AS SumOfWeight,
    SUM([Cost:]) AS SumOfCost
FROM [January, 2016$]
GROUP BY [Delivered to:]

The first step would be to get a list of worksheet names, using the ADO connection.

Then you can iterate over the names and issue the SQL statement. Data comes back as a Recordset object, which can easily be pasted into an Excel worksheet using the CopyRecordset method.

If the output would be to a different workbook, then it would be possible to keep the output workbook open during the whole of the For Each, continuously create new worksheets for each month, and call CopyFromRecordset at each iteration of the For Each. However, when accessing the same workbook via Automation and the ADO connection simultaneously, CopyFromRecordset seemed to do nothing.

Therefore, we're using disconnected recordsets for each worksheet — that store all the data in memory even after the collection is closed; and holding references to them using a Scripting.Dictionary, where each key is the final worksheet name, and the value is the disconnected recordset.

^{This means that all the final data is stored in memory, which could conceivably be an issue. A possible workaround would be to create a new output workbook to hold the pasted recordset data, and when all the iterations are finished and the connection is closed, to paste the worksheets from the output workbook into the original workbook and delete the output workbook. However, you've indicated in the question that you don't want to do this.}

Add references (Tools -> References ...) to Microsoft ActiveX Data Objects (choose the latest version; it's usually 6.1), and Microsoft Scripting Runtime.

Dim pathToWorkbook As String
pathToWorkbook = "C:\path\to\workbook.xlsx"

Dim conn As New ADODB.Connection
Dim schema As ADODB.Recordset
Dim sheetname As Variant
Dim sql As String
Dim rs As ADODB.Recordset
Dim dict As New Scripting.Dictionary

With conn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=""" & pathToWorkbook & """;" & _
        "Extended Properties=""Excel 12.0;HDR=Yes"""
    .Open

    Set schema = .OpenSchema(adSchemaTables)

    For Each sheetname In schema.GetRows(, , "TABLE_NAME") 'returns a 2D array of one column
        If Not sheetname Like "*(Summary)*" Then
            sql = _
                "SELECT [Delivered to:], " & _
                    "COUNT(*) AS NumberOfDeliveries, " & _
                    "SUM([Number Of Pieces:]) AS SumNumberOfPieces, " & _
                    "SUM([Weight:]) AS SumOfWeight, " & _
                    "SUM([Cost:]) AS SumOfCost " & _
                "FROM [" & sheetname & "] " & _
                "GROUP BY [Delivered to:]"

            Set rs = New ADODB.Recordset
            rs.CursorLocation = adUseClient 'This defines a disconnected recordset
            rs.Open sql, conn, adOpenStatic, adLockBatchOptimistic 'Disconnected recordsets require these options
            Set rs.ActiveConnection = Nothing 'Recordset disconnected

            sheetname = Mid(sheetname, 2, Len(sheetname) - 3)
            dict.Add sheetname & " (Summary)", rs
        End If
    Next
    .Close
End With

Dim xlApp As New Excel.Application
xlApp.Visible = True
xlApp.UserControl = True
Dim wkbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim key As Variant
Set wkbk = xlApp.Workbooks.Open(pathToWorkbook)
For Each key In dict.Keys
    Set wks = wkbk.Sheets.Add
    wks.Name = key
    wks.Range("A1").CopyFromRecordset dict(key)
Next

---

Links:

MSDN:

• ADO — Connection and Recordset objects
• How to create disconnected recordsets
• VBA
• Scripting.Dictionary
• Excel automation

Other:

• Using disconnected recordsets