Solved Append Data to Excel Table

[jeran042]

Full disclosure, I did post this code to this form in the past, but that problem has been resolved.

Here is what I am looking to do, and thus far I am unable to come up with any ideas. So I am looking for a little help.

I have command button within an Access (MS Office 2013) form. What this does is pull departmental information from three different recordsets. From there it loops through a directory and opens the corresponding departments excel file and pastes in the recordset data. This all works as expected. The problem is that the record sets are all data for the full year. So each month it would just paste over the entire table within the excel file. I compensated for this by limiting the query to just the previous month data.

What I am looking to do now is to have new data (if any) append to the end of the existing table within each departments report. My code is posted below:

Private Sub Command47_Click()

'BOF checks if current record position is before the first record
'EOF checks if current record position is after the last record
'If BOF and EOF both return TRUE, then the Table has no record
'rs.MoveFirst ‘makes the first record the current record, in case current record is not the first record

'Error handling
    On Error GoTo Error_Handler
    

Dim sCost As String
Dim rsQuery_expense As DAO.Recordset
Dim rsQuery_head As DAO.Recordset
Dim rsQuery_temp_head As DAO.Recordset
Dim rs As DAO.Recordset
Dim dbs As DAO.Database
Dim excelApp As Object
Dim sFilePath As String
Dim sDepartment As String
Dim oSheet As Object
Dim oBook As Object


'This RS is departments who are a stakeholder in an Exhibit 2 line
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("SELECT * FROM qryDepartmentActive")


'Set Variables
sFilePath = "Y:\Budget process information\BUDGET DEPARTMENTS\"
sSubFolder = "\MONTHLY EXPENSE REPORTS\"


'Check to see if the recordset actually contains rows
'Do until there are no more records in the RS
If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst
    Do Until rs.EOF = True


'sCost_Center = 100
sCost_Center = rs.Fields("COST_CENTER")
sDepartment = DLookup("DEPARTMENT", "qryDepartment", "COST_CENTER = " & sCost_Center)


'Specify the query to be exported
    'This detail is limited to just the previous months detail'
    Set rsQuery_expense = dbs.OpenRecordset("SELECT * FROM qryLedger_Detail_2019_Exhibit_monthly WHERE [EXHIBIT_2_COST] = " & sCost_Center & " Or [COST_CENTER] = " & sCost_Center)
    
    'For the following 2 record sources, I can paste over this full table.  Only a couple of records.'
    Set rsQuery_head = dbs.OpenRecordset("SELECT * FROM qry_HEAD_COUNT_AGG_ALL WHERE TBL_HEAD_COUNT_AGG.COST_CENTER = " & sCost_Center)
    Set rsQuery_temp_head = dbs.OpenRecordset("SELECT * FROM qry_TEMP_HEAD_COUNT_AGG_ALL WHERE TBL_TEMP_HEAD_COUNT_AGG.COST_CENTER = " & sCost_Center)
    
    
'Open an instance of Excel
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Applicationn")

    If Err.Number <> 0 Then
    Err.Clear
    'On Error GoTo Error_Handler
    Set excelApp = CreateObject("Excel.Application")
    End If
    Debug.Print "Excel Instance Created"


'Change True to False if you do not want the workbook to be
'Visible when the code is running
    excelApp.Visible = False

'Open the target workbook
    Set targetWorkbook = excelApp.Workbooks.Open(sFilePath & sDepartment & sSubFolder & sDepartment & "_YTD_DETAIL" & ".xlsm")
    Debug.Print "Excel File " & sDepartment & " Opened"

    'Dim tbl As ListObject
    Dim sTable As String

    For Each oSheet In targetWorkbook.Worksheets
       With oSheet
            'MsgBox oSheet.Name
            If oSheet.Name = "EXHIBIT_2_DETAIL_2020" Then
'
'    sTable = oSheet.Name.ListObjects(1).Name
'    Set tbl = oSheet.Name.ListObjects(sTable)
'
                With oSheet.ListObjects("EXHIBIT_2_DETAIL_2020")
                    If Not .DataBodyRange Is Nothing Then
                        .DataBodyRange.Delete
                    End If
                End With
                oSheet.Range("A2").CopyFromRecordset rsQuery_expense
                Debug.Print "Completed the export of Expense Detail For " & sDepartment
            
            ElseIf oSheet.Name = "HEAD_TEMP_COUNT" Then
                oSheet.Range("D3").CopyFromRecordset rsQuery_head
                oSheet.Range("D9").CopyFromRecordset rsQuery_temp_head
                Debug.Print "Completed the export of Head Count and Temp Head Count For " & sDepartment
           
            ElseIf oSheet.Name = "PIVOTS" Then
                oSheet.Range("A1").Value = "EXPENSES REPORT UPDATED: " & Now
                Debug.Print "Report Updated to reflect " & Now & " Timestamp"
            
            ElseIf oSheet.Name = "ACTUALS_VS_PLAN" Then
                oSheet.Range("A1").Value = Month(Date) - 1
            End If 'There will be other sheets in workbook, but the 2 above are the only ones i need to interact with.
       End With
    Next oSheet
    


'Close the EXCEL file while saving the file, and clean up the EXCEL objects
    Set excelApp = Nothing
    
    targetWorkbook.Close True
    Debug.Print sDepartment & " Excel Workbook has been saved and Closed"
    
    Set targetWorkbook = Nothing

    'Debug.Print that we are moving to the next record with 2 line breaks in between
    Debug.Print "Moving to the next Recordset" & vbNewLine & StringTwo
    
    Loop

'Move to the next recordset
    rs.MoveNext
    Debug.Print "Moving to the next Recordset" & vbNewLine & StringTwo

Else
    MsgBox "There are no records in the recordset."
End If

MsgBox "Finished looping through records."

'Close the recordset & clean up
    rs.Close
    Set rs = Nothing



Error_Handler_Exit:

'Close the EXCEL file while saving the file, and clean up the EXCEL objects
    Set excelApp = Nothing
    targetWorkbook.Close True
    Set targetWorkbook = Nothing
    rs.MoveNext

    Exit Sub

Error_Handler:
    Select Case Err.Number
        Case 2302
            MsgBox "There is currently a file open with the name: " & vbCrLf & _
                     sFilename & vbCrLf & _
                    "Please close or rename open file! " _
                    , vbOKOnly + vbExclamation, "DUPLICATE NAME WARNING"
            Resume Error_Handler_Exit
        Case Else
            MsgBox "Error No. " & Err.Number & vbCrLf & "Description: " & Err.DESCRIPTION, vbExclamation, "Database Error"
            Err.Clear
            Resume Error_Handler_Exit
    End Select

 

[June7]

I have to ask - why involve Excel at all?

Excel workbooks holding a lot of data can eventually become slow and cumbersome to the point of non-functional.

And - why not have Excel link to Access data and refresh data from its end?

Appending rows requires locating first blank row at end of range and setting that as starting point for loop.

 

[jeran042]

Good question. The problem with making a data connection, is that it will break when we distribute the reports to the departments.
If you find the first blank row, with that become part of the table? There are formulas (obviously) that are working on these tables.

 

[jeran042]

So here is what I am trying. It does not seem to be working.
When I debug.print the LastRow is shows 0?

'Open the target workbook
    Set targetWorkbook = excelApp.Workbooks.Open(sFilePath & sDepartment & sSubFolder & sDepartment & "_YTD_DETAIL" & ".xlsm")
    Debug.Print "Excel File " & sDepartment & " Opened"

    'Dim tbl As ListObject
    Dim sTable As String
    Dim LastRow As Long

    For Each oSheet In targetWorkbook.Worksheets
       With oSheet
            'MsgBox oSheet.Name
            If oSheet.Name = "EXHIBIT_2_DETAIL_2020" Then
                With oSheet.ListObjects("DETAIL_2020")
                    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                    Debug.Print LastRow
                    oSheet.Range("A" & LastRow).CopyFromRecordset rsQuery_expense
                End With
                Debug.Print "Completed the export of Expense Detail For " & sDepartment

 

[Gasman]

Instead of repeating the LastRow code for every sheet, put it where you have
MsgBox oSheet.Name
as you need it regardless of what sheet you are on.?

I use this for my last row, ensuring the column contains data to the bottom.

 lLastRow = Range("B" & Rows.Count).End(xlUp).Row

 

[jeran042]

This makes sense, except now I get a compiler error, Sub or Function not defined. On the "Range"

Open the target workbook
    Set targetWorkbook = excelApp.Workbooks.Open(sFilePath & sDepartment & sSubFolder & sDepartment & "_YTD_DETAIL" & ".xlsm")
    Debug.Print "Excel File " & sDepartment & " Opened"

    'Dim tbl As ListObject
    Dim sTable As String
    Dim lLastRow As Long

    For Each oSheet In targetWorkbook.Worksheets
       With oSheet
            lLastRow = Range("B" & Rows.Count).End(xlUp).Row
            If oSheet.Name = "EXHIBIT_2_DETAIL_2020" Then
                With oSheet.ListObjects("DETAIL_2020")
                    Debug.Print LastRow
                    oSheet.Range("A" & LastRow).CopyFromRecordset rsQuery_expense
                End With
                Debug.Print "Completed the export of Expense Detail For " & sDepartment
            ElseIf oSheet.Name = "HEAD_TEMP_COUNT" Then
                oSheet.Range("D3").CopyFromRecordset rsQuery_head
                oSheet.Range("D9").CopyFromRecordset rsQuery_temp_head
                Debug.Print "Completed the export of Head Count and Temp Head Count For " & sDepartment
            ElseIf oSheet.Name = "PIVOTS" Then
                oSheet.Range("A1").Value = "EXPENSES REPORT UPDATED: " & Now
                Debug.Print "Report Updated to reflect " & Now & " Timestamp"
            ElseIf oSheet.Name = "ACTUALS_VS_PLAN" Then
                oSheet.Range("A1").Value = Month(Date) - 1
            End If 'There will be other sheets in workbook, but the 2 above are the only ones i need to interact with.
       End With
    Next oSheet
    
Stop

 

[Gasman]

Well, that was just an example?
As you prefixed the Cells with a ., you should do the same for Range I would expect.?
My code actually came from an Excel workbook, but the logic is the same.?

Also make sure the column you choose has data all the way to the bottom.? If B is not your column, that is not going to work?

 

[Gasman]

You *might* also have to add row by row if you are using a table?

VBA Tables and ListObjects

This tutorial will demonstrate how to work with Tables and ListObjects in VBA. VBA Tables and ListObjects Tables are one of Excel’s most useful and

www.automateexcel.com

Again, not something I have had to do

 

[CJ_London]

Providing you have a recognisable table in your excel file you can use sql to append data rather than opening excel, finding the last row and adding new rows.

You need a select query to the excel file (effectively an updateable linked table) - if appending to multiple excel files using vba, update the query def with the filename as part of the process. The select query would look something like this

SELECT *
FROM (SELECT * FROM [sheet1$] AS xlData IN 'C:\path\filename.xlsx'[Excel 12.0;HDR=yes;IMEX=0;ACCDB=Yes]) AS XL

[sheet1$] can be modified to any range - for example [sheet1$A2:B] will select just the first two columns starting with headers on row 2. If rows and columns are not specified, the data selected is the equivalent of using end>home - so it will not return 1m rows unless someone has entered something on the last row

Note this query is updateable in that you can edit data and manually add new rows. You cannot delete rows. The excel file can even be open - but not tested where someone else has already got the file open.

There are other constraints - you can have multiple tables in one worksheet - but they must be place horizontally, not vertically - and you will need to specify the related columns. Also, Access will datatype each column so incorrect datatypes such as text in a numeric column will display #error - but you can edit it to correct if you know what the correct value should be.

next create an append query which might be something like this

INSERT INTO qryExcel ( expense, cost )
SELECT expense, cost 
FROM tblBudget
Where expDate>Date()-30

Note that you cannot use the query builder to select qryExcel as the target table. Instead, select any table, then go into sql view and change to the query name. One you have done that, you can return to the query builder to select more fields to update. For vba, you might want to modify the sql string as and when required.

 

[Pat Hartman]

If the Excel is not the "master" and it should not be, then rather than updating an existing Excel file, simply create a new one each time you want to produce a new report. I didn't follow all the code closely but it seems like this solution is more complicated than it needs to be.

 

[arnelgp]

you can also add the recordset for the month as a New Sheet (Jan2020, Feb2020, etc.) instead of appending to existing sheet.
if there are adjustment to previous month, what shall you do? delete all rows for the month and re-insert?
will take much code and scratching of head.

 

[jeran042]

If the Excel is not the "master" and it should not be, then rather than updating an existing Excel file, simply create a new one each time you want to produce a new report. I didn't follow all the code closely but it seems like this solution is more complicated than it needs to be.

That is what is happening now. Each month the table gets wiped clean and the full years history is pasted in. I thought it would be more efficient to just append new records then delete all old and repaste.

 

[jeran042]

you can also add the recordset for the month as a New Sheet (Jan2020, Feb2020, etc.) instead of appending to existing sheet.
if there are adjustment to previous month, what shall you do? delete all rows for the month and re-insert?
will take much code and scratching of head.

Thank you, the problem is that there is a Summary sheet that does a number of calculations. So to have multiple sheets would make it very difficult to calculate the YTD dollars. There will never be adjustments to previous months. They would be accounted for in the following month. Think a reclassing of an expense, it would show either in the same month or in the next months details.

 

[jeran042]

Providing you have a recognisable table in your excel file you can use sql to append data rather than opening excel, finding the last row and adding new rows.

You need a select query to the excel file (effectively an updateable linked table) - if appending to multiple excel files using vba, update the query def with the filename as part of the process. The select query would look something like this

SELECT *
FROM (SELECT * FROM [sheet1$] AS xlData IN 'C:\path\filename.xlsx'[Excel 12.0;HDR=yes;IMEX=0;ACCDB=Yes]) AS XL

[sheet1$] can be modified to any range - for example [sheet1$A2:B] will select just the first two columns starting with headers on row 2. If rows and columns are not specified, the data selected is the equivalent of using end>home - so it will not return 1m rows unless someone has entered something on the last row

Note this query is updateable in that you can edit data and manually add new rows. You cannot delete rows. The excel file can even be open - but not tested where someone else has already got the file open.

There are other constraints - you can have multiple tables in one worksheet - but they must be place horizontally, not vertically - and you will need to specify the related columns. Also, Access will datatype each column so incorrect datatypes such as text in a numeric column will display #error - but you can edit it to correct if you know what the correct value should be.

next create an append query which might be something like this

INSERT INTO qryExcel ( expense, cost )
SELECT expense, cost
FROM tblBudget
Where expDate>Date()-30

Note that you cannot use the query builder to select qryExcel as the target table. Instead, select any table, then go into sql view and change to the query name. One you have done that, you can return to the query builder to select more fields to update. For vba, you might want to modify the sql string as and when required.

This is an excellent suggestion. However it does not suite my needs. The reports being updated are sent to a variety of departments, none of which will have read access to the drive that the MS Access database sits on. I think the link would be broken and all they would see is an error message? (Correct me if I am incorrect)

 

[CJ_London]

you are incorrect - the query updates Excel

 

[jeran042]

you are incorrect - the query updates Excel

But would the connection be broken if theses excel files were sent out and the user did not have read access to the database?

 

[jeran042]

I have made a little headway, but am stuck again.
I cant figure out why its not pasting the values to the table. The output of the debug.print is telling me I am right where I should be.

'Open the target workbook
Set targetWorkbook = excelApp.Workbooks.Open(sFilePath & sDepartment & sSubFolder & sDepartment & "_YTD_DETAIL" & ".xlsm")
Debug.Print targetWorkbook.Name
' Debug.Print "Excel File " & sDepartment & " Opened"
' Debug.Print sFilePath & sDepartment & sSubFolder & sDepartment & "_YTD_DETAIL" & ".xlsm"

'Dim tbl As ListObject
Dim sTable As String
Dim LastRow As Long

For Each oSheet In targetWorkbook.Worksheets
If oSheet.Name = "EXHIBIT_2_DETAIL_2020" Then
Debug.Print oSheet.Name
With oSheet.ListObjects("DETAIL_2020")
LastRow = oSheet.Range("DETAIL_2020").Rows.Count + FirstRow
Debug.Print LastRow
oSheet.Range("A2:A" & LastRow).CopyFromRecordset rsQuery_expense
End With
'Debug.Print "Completed the export of Expense Detail For " & sDepartment
ElseIf oSheet.Name = "HEAD_TEMP_COUNT" Then
oSheet.Range("D3").CopyFromRecordset rsQuery_head
oSheet.Range("D9").CopyFromRecordset rsQuery_temp_head
Debug.Print "Completed the export of Head Count and Temp Head Count For " & sDepartment
ElseIf oSheet.Name = "PIVOTS" Then
oSheet.Range("A1").Value = "EXPENSES REPORT UPDATED: " & Now
Debug.Print "Report Updated to reflect " & Now & " Timestamp"
ElseIf oSheet.Name = "ACTUALS_VS_PLAN" Then
oSheet.Range("A1").Value = Month(Date) - 1
End If 'There will be other sheets in workbook, but the 2 above are the only ones i need to interact with.
Next oSheet

Stop


[/CODE]


Output
' There are records'
The Ledger table contains 70 records.

' The excel instance is created'
Excel Instance Created

' The correct file is open'
Accounting_YTD_Detail.xlsm

' correct tab with the correct table with records'
EXHIBIT_2_DETAIL_2020

' The last row
10662

 

[Gasman]

I believe if you use copyfromrecordset, then you just specify a starting cell, not a range?

Range.CopyFromRecordset method (Excel)

Office VBA reference topic

docs.microsoft.com

 

[jeran042]

I got it working. Here is what it ended up being:

'Open the target workbook
    Set targetWorkbook = excelApp.Workbooks.Open(sFilePath & sDepartment & sSubFolder & sDepartment & "_YTD_DETAIL" & ".xlsm")
     Debug.Print targetWorkbook.Name
'    Debug.Print "Excel File " & sDepartment & " Opened"
'    Debug.Print sFilePath & sDepartment & sSubFolder & sDepartment & "_YTD_DETAIL" & ".xlsm"
    
    'Dim tbl As ListObject
    Dim sTable As String
    Dim LastRow As Long
    
    For Each oSheet In targetWorkbook.Worksheets
            If oSheet.Name = "EXHIBIT_2_DETAIL_2020" Then
                'Debug.Print oSheet.Name
                With oSheet.ListObjects("DETAIL_2020")
                    LastRow = oSheet.Range("DETAIL_2020").Rows.Count + FirstRow
                    'Debug.Print LastRow
                    oSheet.Range("A" & LastRow).CopyFromRecordset rsQuery_expense
                    ' Sort table decending newest date first )WIP
                    'Range("A1:W" & LastRow).Sort Key5:=Range("E:E"), Order1:=xlDescending, Header:=xlNo
                End With
                'Debug.Print "Completed the export of Expense Detail For " & sDepartment
            ElseIf oSheet.Name = "HEAD_TEMP_COUNT" Then
                oSheet.Range("D3").CopyFromRecordset rsQuery_head
                oSheet.Range("D9").CopyFromRecordset rsQuery_temp_head
                Debug.Print "Completed the export of Head Count and Temp Head Count For " & sDepartment
            ElseIf oSheet.Name = "PIVOTS" Then
                oSheet.Range("A1").Value = "EXPENSES REPORT UPDATED: " & Now
                Debug.Print "Report Updated to reflect " & Now & " Timestamp"
            ElseIf oSheet.Name = "ACTUALS_VS_PLAN" Then
                oSheet.Range("A1").Value = Month(Date) - 1
            End If 'There will be other sheets in workbook, but the 2 above are the only ones i need to interact with.
    Next oSheet

Next steps is to sort the table from Newest to Oldest and trim the cells (Still a work in process).

Thank you everyone for your help!

 

[Pat Hartman]

Start with an Excel template that includes all your calculations. Put all the data on a separate page so it is easy to insert. Then to create the new "report", copy the template and insert the data into the data sheet. Have the macros calculate on opening so all the summary gets updated.