Is it possible to loop through all tables that contain a prefix?-CodePudding

Range("TableIR000[Deductions in Month]").Copy
Range("TableIR000[Previous Deductions]").PasteSpecial xlPasteValues, Operation:=xlAdd
Range("TableIR001[Deductions in Month]").Copy
Range("TableIR001[Previous Deductions]").PasteSpecial xlPasteValues, Operation:=xlAdd
Range("TableIR002[Deductions in Month]").Copy
Range("TableIR002[Previous Deductions]").PasteSpecial xlPasteValues, Operation:=xlAdd
Range("TableIR002a[Deductions in Month]").Copy
Range("TableIR002a[Previous Deductions]").PasteSpecial xlPasteValues, Operation:=xlAdd

As you can see, all the tables I want to loop through start with "TableIR" in the name. I want the loop to ignore all tables without that prefix.

I currently have about 70 tables like this so a lot of repetitive lines. Every time I add another table, I will have to manually add another 2 lines of code.

CodePudding user response：

Assuming that "Sheet1" contains your tables, try...

Dim listObj As ListObject
For Each listObj In Worksheets("Sheet1").ListObjects 'change the sheet name accordingly
    If Left(listObj.Name, 7) = "TableIR" Then
        Range(listObj.Name & "[Deductions in Month]").Copy
        Range(listObj.Name & "[Previous Deductions]").PasteSpecial xlPasteValues, Operation:=xlAdd
    End If
Next listObj

To loop through each worksheet within the workbook running the code...

Dim ws As Worksheet
Dim listObj As ListObject
For Each ws In ThisWorkbook.Worksheets
    For Each listObj In ws.ListObjects
        If Left(listObj.Name, 7) = "TableIR" Then
            Range(listObj.Name & "[Deductions in Month]").Copy
            Range(listObj.Name & "[Previous Deductions]").PasteSpecial xlPasteValues, Operation:=xlAdd
        End If
    Next listObj
Next ws

CodePudding user response：

Update Excel Table Column Using `Worksheet.Evaluate`

... instead of letting Range.PasteSpecial mess up the selection(s).

Sub UpdateDeductions()

    Const COPY_COLUMN As String = "Deductions in Month"
    Const PASTE_COLUMN As String = "Previous Deductions"
    Const BEGINS_WITH  As String = "TableIR"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet, lo As ListObject, crg As Range, prg As Range
    Dim cAd As String, pAd As String, EvalFormula As String
    
    For Each ws In wb.Worksheets
        For Each lo In ws.ListObjects
            If InStr(1, lo.Name, BEGINS_WITH, vbTextCompare) = 1 Then
                Set crg = lo.ListColumns(COPY_COLUMN).DataBodyRange
                Set prg = lo.ListColumns(PASTE_COLUMN).DataBodyRange
'                ' This is nice but messes up the selections:
'                crg.Copy
'                prg.PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd
                ' I would prefer this:
                cAd = crg.Address
                pAd = prg.Address
                EvalFormula = "IFERROR(" & pAd & " " & cAd & "," & pAd & ")"
                'Debug.Print cAd, pAd, EvalFormula
                prg.Value = ws.Evaluate(EvalFormula)
            End If
        Next lo
    Next ws

    ' If for some reason you stick with 'PasteSpecial', you will also use this:
    'Application.CutCopyMode = False

    'wb.Save

    ' It should be pretty fast so to assure yourself that it has run, use:
    MsgBox "Deductions updated.", vbInformation

End Sub

Update Excel Table Column Using Worksheet.Evaluate

Update Excel Table Column Using `Worksheet.Evaluate`