Collectives™ on Stack Overflow

Find centralized, trusted content and collaborate around the technologies you use most.

Teams

Q&A for work

Connect and share knowledge within a single location that is structured and easy to search.

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

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
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.
                You didn't include it in your GROUP BY. If you need it in the output, you need to include it in the fields that are listed to group by as well. I did mention that in my comment originally against your question. You then commented back that you'd removed it. So I assumed you were happy that it was removed.
– CLR
                Jul 9, 2018 at 9:26
        
Thanks for contributing an answer to Stack Overflow!
Please be sure to answer the question. Provide details and share your research!
But avoid …
Asking for help, clarification, or responding to other answers.
Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.