CODEWITHSUNDEEP
sqlvbaexceladodb
Ashok
Ashok

Reputation: 394

Automation Error with SQL Query with SUM and GROUP BY on an Excel Table

I am trying to group by and sum specific columns by using SQL queries and copy the result into another work sheet but it's throwing

Run-time error -2147217887 (80040e21): Automation Error

I can't figure out why for whatever reason and throwing error at .Open.

please find the pics of Excel table

enter image description here

Code: 

Sub CreateConsolidatedTable()
    Const adOpenKeyset = 1
    Const adLockOptimistic = 3
    Const WORKSHEETNAME As String = "Sheet1"
    Const TABLENAME As String = "Table1"

    Dim conn As Object, rs As Object
    Dim tbl As ListObject

    Dim Destination As Range
    Set Destination = ThisWorkbook.Worksheets("Sheet2").Range("C1")
Set rg = ThisWorkbook.Worksheets("Sheet1").UsedRange
Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects.Add(xlSrcRange, rg, , xlYes)

    'Set tbl = Worksheets(WORKSHEETNAME).ListObjects(TABLENAME)

    Set conn = CreateObject("ADODB.Connection")
    conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

    conn.Open
    '  On Error GoTo CloseConnection
    Set rs = CreateObject("ADODB.Recordset")
    With rs
        .ActiveConnection = conn
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Source = getSQL(tbl)
        .Open

        With Destination
            tbl.HeaderRowRange.Copy .Range("c1")
            .Range("c2").CopyFromRecordset rs
            .Parent.ListObjects.Add SourceType:=xlSrcRange, Source:=.Range("c1").CurrentRegion, XlListObjectHasHeaders:=xlYes, TableStyleName:=tbl.TableStyle

        End With
    End With
CloseRecordset:
    rs.Close
    Set rs = Nothing
CloseConnection:
    conn.Close
    Set conn = Nothing
End Sub

Function getSQL(tbl As ListObject) As String
    Dim SQL As String, SheetName As String, RangeAddress As String
    SQL = "SELECT DISTINCTROW [DATE_], [ACCOUNT_CODE], Sum([PRINCIPAL_DUE]) AS [Sum Of PRINCIPAL_DUE],[GL_HEAD_CODE_PRINCIPAL], Sum([INTEREST_DUE]) AS [INTEREST_DUE],[INTEREST_RATE]" & _
          " FROM [SheetName$RangeAddress]" & _
          " GROUP BY [ACCOUNT_CODE], [GL_HEAD_CODE_PRINCIPAL], [DATE_];"

    SheetName = tbl.Parent.Name
    RangeAddress = tbl.Range.Address(False, False)
Debug.Print SheetName
Debug.Print RangeAddress
    SQL = Replace(SQL, "SheetName", SheetName)
    SQL = Replace(SQL, "RangeAddress", RangeAddress)

    getSQL = SQL
End Function

Upvotes: 0

Views: 998

Answers (1)

CLR
CLR

Reputation: 12279

The following SQL line works fine for me, it groups and sums accordingly.

SQL = "SELECT [DATE_], [ACCOUNT_CODE], Sum([PRINCIPAL_DUE]) AS [Sum Of PRINCIPAL_DUE],[GL_HEAD_CODE_PRINCIPAL], Sum([INTEREST_DUE]) AS [INTEREST_DUE] " & _
      " FROM [SheetName$RangeAddress]" & _
      " GROUP BY [ACCOUNT_CODE], [GL_HEAD_CODE_PRINCIPAL], [DATE_];"

That's based on my mock-up data. If you're getting the same number of rows output as input, then check that the fields you're grouping by aren't hiding any extra data (like a time-stamp in the date column for instance) that would fragment the grouping.

Upvotes: 1

Related Questions