Create running data table from daily table updates in another closed workbook

[ddander54]

I currently have a process to get current data (aggregated from numerous pivot tables) in another closed workbook that has previously been updated that day.
This is the output from the code below:

This is the code I use to get today's (Current) data from the other closed workbook.

Option Explicit

'https://www.exceltip.com/import-and-export-in-vba/import-data-from-a-closed-workbook-ado-using-vba-in-microsoft-excel.html

Sub TestReadDataFromWorkbook()
Call RectangleRoundedCorners1_Click
Call HideShape
Dim WB As Excel.Workbook
Dim ws As Worksheet
Set WB = Workbooks.Open("C:\FolderName\SubFolderName\Test_20220825.xlsm")
Set ws = WB.Sheets("Sheet1")
ws.Range("M3:M10").Copy ws.Range("N3:N10")  'Copy From Range... Copy To Range
ws.Range("M3").Select
' fills data from a closed workbook in at the active cell
Dim tArray As Variant, r As Long, c As Long
    tArray = ReadDataFromWorkbook("P:\FolderName\SubFolderName\FileName.xlsx", "August")  'August is the current RangeName August = [IT Core]$I25:$!33

    ' without transposing
    For r = LBound(tArray, 2) To UBound(tArray, 2)
        For c = LBound(tArray, 1) To UBound(tArray, 1)
            ActiveCell.Offset(r, c).Formula = tArray(c, r)
        Next c
    Next r
    ' with transposing
'    tArray = Application.WorksheetFunction.Transpose(tArray)
'    For r = LBound(tArray, 1) To UBound(tArray, 1)
'        For c = LBound(tArray, 2) To UBound(tArray, 2)
'            ActiveCell.Offset(r - 1, c - 1).Formula = tArray(r, c)
'        Next c
'    Next r
End Sub

Private Function ReadDataFromWorkbook(SourceFile As String, SourceRange As String) As Variant
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
'   this function can only return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
'   this function can return data from any worksheet in SourceFile
' SourceRange must include the range headers
' examples:
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:A21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:B21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "DefinedRangeName")
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
    dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};ReadOnly=1;DBQ=" & SourceFile
    'If any issue with MSDASQL Provider, Try the Microsoft.Jet.OLEDB:
'    dbConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SourceFile & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
    Set dbConnection = New ADODB.Connection
    On Error GoTo InvalidInput
    dbConnection.Open dbConnectionString ' open the database connection
    Set rs = dbConnection.Execute("[" & SourceRange & "]")
    On Error GoTo 0
    ReadDataFromWorkbook = rs.GetRows ' returns a two dim array with all records in rs
    rs.Close
    dbConnection.Close ' close the database connection
    Set rs = Nothing
    Set dbConnection = Nothing
    On Error GoTo 0
    Exit Function
InvalidInput:
    MsgBox "The source file or source range is invalid!", vbExclamation, "Get data from closed workbook"
    Set rs = Nothing
    Set dbConnection = Nothing
End Function

The ask.....
What I would like to do is have another vba script that would add to a data table by date in the same workbook where this script is running ("C:\FolderName\SubFolderName\Test_20220825.xlsm")
Basically adding the same 7 rows (Text1-7 is static text), with todays date, Total Hours from 'Current' Column M, and daily hours from 'Increase Col O to the bottom of the table.
Result would be a table:

IT Core	Run Date	Total Hours	Daily Hours
Text1	8/23/2022​	3101​	198​
Text2	8/23/2022​	2201​	132​
Text3	8/23/2022​	2793​	215​
Text4	8/23/2022​	2891​	198​
Text5	8/23/2022​	621​	12​
Text6	8/23/2022​	4702​	318​
Text7	8/23/2022​	3719​	251​
Text1	8/24/2022​	3391​	290​
Text2	8/24/2022​	2299​	99​
Text3	8/24/2022​	2898​	105​
Text4	8/24/2022​	3083​	192​
Text5	8/24/2022​	639​	18​
Text6	8/24/2022​	4863​	161​
Text7	8/24/2022​	3875​	156​
Text1	8/25/2022​	3605​	214​
Text2	8/25/2022​	2451​	152​
Text3	8/25/2022​	3187​	289​
Text4	8/25/2022​	3282​	200​
Text5	8/25/2022​	663​	24​
Text6	8/25/2022​	5089​	226​
Text7	8/25/2022​	4132​	258​

Thoughts?

TIA,
Don

 

[ddander54]

Ok, so here is the method that I used to get my data to the table and add to it everyday that I run the macro.....I'm copying 4 separate ranges that are the same number of rows (7) and add it to my data table to create a history of data to report on later. The code above is supplying the data in the 3 of the separate ranges and a function is providing the 4th range for the 7 rows (the current date). You will notice in Range B, C, D, I had to use the Offset (-6) to get the data to line up with Column A or it kept inserting to the table 7 rows down successively for each range, (ie adding 28 rows of partial data, rather than 7 of complete data).
This code is simple for me to understand and it works fine, but now my question is.... Is there a better way to write this?

Option Explicit

'https://www.mrexcel.com/board/threads/vba-macro-paste-values-to-last-row-of-table.493475/
'Author:  VoG
Sub CopyData()
With Sheets("Sheet1")
    .Range("L3:L9").Copy
    Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues   'Text
    .Range("C15:C21").Copy
    Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(-6).PasteSpecial Paste:=xlPasteValues   'Current Short Date
    .Range("M3:M9").Copy
    Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(-6).PasteSpecial Paste:=xlPasteValues   'Number
    .Range("O3:O9").Copy
    Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(-6).PasteSpecial Paste:=xlPasteValues   'Number
End With
End Sub