How to dynamically refer to a Referenced Table when looping through sheets?

[Pteroglossus]

Hi,

I' ve been working on a VBA script to automate a series of action I have to take on daily generated .csv files structured as follows:

The raw data is located in colums A to H, the script adds a "remark" column in I and then pastes various Countifs formulas in column J to AL.

The number of rows varies daily.

Using bits of code I found here and there, I've been able to write 7 steps but I'm now really stuck. Here is what I have so far:

Sub Csv_proccessing_sequence()
    Dim xFilesToOpen As Variant
    Dim i As Integer
    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String
    Dim xScreen As Boolean
    Dim sourceColumn As Range, targetColumn As Range
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim Rtable As ListObject
    Dim TblRng As Range
 '1 - import csv file
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = ":"
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Kutools for Excel", , True)
    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , "Kutools for Excel"
        GoTo ExitHandler
    End If
    i = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(i))
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    xWb.Worksheets(i).Columns("A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=False, _
      Other:=True, OtherChar:=xDelimiter
'2 - delete columns D and I
      Range("D:D,I:I").Delete
'3 - Add header column I
      Cells(1, 9).Value = "Obs"
'4- Copy columns from Formula tab
      Set sourceColumn = Workbooks("Import_txt_.xlsm").Worksheets(2).Columns("J:AM")
      Set targetColumn = xWb.Worksheets(1).Columns("J:AM")
      sourceColumn.Copy Destination:=targetColumn
    targetColumn.ColumnWidth = sourceColumn.ColumnWidth
'5 - Define lastrow and last column and copy all formulas down
      lastRow = Cells(Rows.Count, "B").End(xlUp).Row
      lastColumn = Cells(Columns.Count).End(xlToLeft).Column
      Range("J4:AM4").Select
      Selection.AutoFill Destination:=Range("J4:AM" & lastRow), Type:=xlFillCopy
'6 - Center all cells
    With xWb.Worksheets(i).Cells
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
'7 - Turn into a referenced table
    With xWb.Worksheets(i)
    Set TblRng = .Range("A1", .Cells(lastRow, lastColumn))
    Set Rtable = .ListObjects.Add(xlSrcRange, TblRng, , xlYes)
    End With

'8 - 'Add "Total" and drag sum right

    Rtable.ShowTotals = True
    Rtable.ListColumns("Arr IFR").TotalsCalculation = xlTotalsCalculationSum
    Range("Tableau1[[#Totals],[Arr IFR]]").Select
    Selection.AutoFill Destination:=Range( _
        "Tableau1[[#Totals],[Arr IFR]:[TDP/RDG]]"), Type:=xlFillDefault
    Range("Tableau1[[#Totals],[Arr IFR]:[TDP/RDG]]").Select
    Selection.Font.Size = 20
    Selection.Font.Bold = True

' 9- loop
    Do While i < UBound(xFilesToOpen)
        i = i + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(i))
        With xWb
            xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count)
            .Worksheets(i).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=xDelimiter
        'delete columns D and I
              Range("D:D,I:I").Delete
        'Add header column I
              Cells(1, 9).Value = "Obs"
        'Copy column from Formula tab
              Set sourceColumn = Workbooks("Import_txt_.xlsm").Worksheets(2).Columns("J:AM")
              Set targetColumn = xWb.Worksheets(i).Columns("J:AM")
              sourceColumn.Copy Destination:=targetColumn
        'Define lastrow and copy all formulas down
                lastRow = Cells(Rows.Count, "B").End(xlUp).Row
                lastColumn = Cells(Columns.Count).End(xlToLeft).Column
                Range("J4:AM4").Select
                Selection.AutoFill Destination:=Range("J4:AM" & lastRow), Type:=xlFillCopy
        'Center all cells
            With xWb.Worksheets(i).Cells
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        'Turn into a table
            With xWb.Worksheets(i)
            Set TblRng = .Range("A1", .Cells(lastRow, lastColumn))
            Set Table = .ListObjects.Add(xlSrcRange, TblRng, , xlYes)
            Table.Name = "DynTable"
            End With
        'Display "total" line and drag sum formula right + font size
            
            Rtable.ShowTotals = True
            Rtable.ListColumns("Arr IFR").TotalsCalculation = _
                xlTotalsCalculationSum
            Range("Table, [[#Totals][Arr IFR]]").Select
            Selection.AutoFill Destination:=Range( _
                "Tableau(i)[[#Totals],[Arr IFR]:[TDP/RDG]]"), Type:=xlFillDefault
            Range("Tableau(i)[[#Totals],[Arr IFR]:[TDP/RDG]]").Select
            Selection.Font.Size = 20
        
    End With
    Loop
ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Kutools for Excel"
    Resume ExitHandler
End Sub

The "Add total…" remark line is where I'm stuck. Using the macro recording tool, the code given works for the first iteration of script, but won’t work the loop part, as “Tableau1” will become “Tableau2” and so on.

I’ve been trying to refer to the table dynamically using the variables “Rtable” and “TabRng”, but either it’s not possible or I can’t get the syntax right.

Could anyone give me a hint?

Also, if you see anything else that could be improved please let me know

Best,
KL

 

[Pteroglossus]

I think I understand what you mean but I'm not sure how it applies to the issue I encountered. But I'll figure it out eventually. Thanks for your help