retreive data on last create named range from previous inserted named range

Carlton 0
Viewed 23

I have 3 named table : Table11, Table34, Table41.
The idea is that, any time I am inserting/adding a new table(lets say Table56), in the new table I need to add the data from previous inserted added table data: the values from columns Tax1, Tax2, Fees.
Sometimes the table might have additional columns and rows, which it shouldn't affect retrieving data from a previous table into a new table. Also, it might happen that the name of tables to be different, because the file is accessed by different users
The name of the table is added as a list in another worksheet when the table is created, for this I was able to create a small code using a template table (copy and paste).

enter image description here enter image description here

So, is it possible to retrieve data in last named table from previous inserted named table?

Anyone can give me a helpful hand?

listobject vba excel
1 Answers

Update New Table With Data From Previously Added Table

enter image description here

Sub UpdateNewTable()
    
    ' Define constants.
    
    Const wsName As String = "Report"
    Const CriteriaHeader As String = "ID"
    Const sTableHeadersList As String _
        = "Wage,Tax1,Tax2,Fees"
    Const dTableHeadersList As String _
        = "Wage Previous,Tax1 Previous,Tax2 Previous,Fees Previous"
    
    ' Reference the objects.
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    Dim tblCount As Long: tblCount = ws.ListObjects.Count
    If tblCount < 2 Then Exit Sub
    
    Dim stbl As ListObject: Set stbl = ws.ListObjects(tblCount - 1)
    Dim dtbl As ListObject: Set dtbl = ws.ListObjects(tblCount)
    
    Dim srg As Range: Set srg = stbl.ListColumns(CriteriaHeader).DataBodyRange
    Dim drg As Range: Set drg = dtbl.ListColumns(CriteriaHeader).DataBodyRange
    
    ' Read data.
    
    ' A 2D one-based one-column array with the same number of rows
    ' as the source (one-column) range, holding the destination (table)
    ' row indexes where the source values were found.
    ' There will be error values for not found values ('IsNumeric').
    Dim drIndexes As Variant: drIndexes = Application.Match(srg, drg, 0)
    
    Dim sHeaders() As String: sHeaders = Split(sTableHeadersList, ",")
    Dim dHeaders() As String: dHeaders = Split(dTableHeadersList, ",")
    Dim hUpper As Long: hUpper = UBound(sHeaders)
    
    ' Write (copy) data.
    
    Dim sr As Long
    Dim dr As Long
    Dim hc As Long
    
    For sr = 1 To UBound(drIndexes) ' or '1 To srg.Rows.Count'
        If IsNumeric(drIndexes(sr, 1)) Then
            dr = drIndexes(sr, 1)
            For hc = 0 To hUpper
                dtbl.ListColumns(dHeaders(hc)).DataBodyRange.Rows(dr).Value _
                    = stbl.ListColumns(sHeaders(hc)) _
                        .DataBodyRange.Rows(sr).Value
            Next hc
        End If
    Next sr

    ' Inform.
    
    MsgBox "New table updated.", vbInformation

End Sub
VBasic20080
Related