Table question - Adjust one table column list, have it automatically update other worksheets

[LlebKcir]

One of my workbooks has a default template table that all of the other worksheets are based on. One goal for this workbook is to keep all worksheets using that template identical. Currently If I add, move, or remove a column on the template worksheet, I then have to manually perform the same task on all other worksheets. Excel does not like copy/paste columns into tables. Complains that you are moving cells around, well duh thats what I want to do silly Excel.

current process:

1. manually insert new column into template & give new column header title.
2. repeat for all worksheets in the workbook.
3. If adding formulas into new column, manually copy/paste after creation of new columns to all worksheets.

This is both time consuming and a bit of an irritant.

desire:

1. manually update template worksheet
2. all other worksheets receive the new column with any code associated with new column

This does not need to be "real time" can be a forced function from a button, F5, etc...

Directions on if this is A possible, B if possible, what path to head down to start my research on how this is accomplished. Not even sure what questions to ask the all mighty googs to start :D.

 

[Yongle]

The VBA below
- loops through all sheets in the workbook
- identifies the first table on that sheet (if any)
- inserts new column 3
- with header "Header XXX"
- and places a simple formula in the first cell of that column (which Excel auto-fills down the whole column)

Are all tables identical in layout ?
- if not you may need to add conditions to exclude certain sheets etc

The code does not fail if there is not a table on any sheet
- on error resume next lazily ignores any such problem
- any line referring to a list object (when there isn't one) is conveniently hopped over

Sub InsertColumnWithTitleAndFormula()
    Dim ws As Worksheet, tbl As ListObject
    For Each ws In ThisWorkbook.Sheets
        On Error Resume Next
        Set tbl = ws.ListObjects(1)
        tbl.ListColumns.Add Position:=3
        tbl.HeaderRowRange(1, 3) = "Header XXX"
        tbl.DataBodyRange(1, 3).Formula = "=[@Man]&"" & ""&[@Woman]"
        On Error GoTo 0
    Next
End Sub

My table

Essential bedtime reading for you

The VBA Guide To ListObject Excel Tables

For a data analyst, Excel Tables are a necessity! They are the most efficient way to organize your raw data and refer to data that contracts or expands on a regular basis. Likewise, Excel tables can be extremely useful in combination with VBA.

www.thespreadsheetguru.com

 

[Yongle]

I know that is not quite what you asked - but it illustrates how little code is reqired to do the amendments

If I have time tomorrow I will look at writing some code that would specifically look at your template, compare it to the first real table in your worbook, determine what is different and making the required modifications

What is the name of your template ?
Which sheet contains it ?
Do all worksheets contain the same table ?

 

[LlebKcir]

Yongle, thank you for both posts. I will look at the code you offered. That is an option as it would be easier to edit that bit of code, run it, than to manually add and edit on each worksheet.

 

[LlebKcir]

What is the name of your template ?
Which sheet contains it ?
Do all worksheets contain the same table ?

The template name = tTemplate
The worksheet is named Template
Currently their are 2 worksheets that do not use that template. They contain either notes to updates, or raw data used to populate field or just information.

 

[Yongle]

Ok will post code tomorrow capable of adding, deleting and moving a column

Are you happy for the code to be written based on single-column change only ?
ie change ONE column and run the code, change another column and run the code
The resaon I ask is that it will simplify the code

 

[LlebKcir]

Yes, typically when there are changes to the template it is a simple add or move a column. As the project grows I am sure there will be more columns added over time.

 

[Yongle]

Are you happy for the code to be written based on the FIRST remaining unchanged?
ie never delete that column nor insert another column as a new first column
The resaon I ask is that it will simplify the code

 

[LlebKcir]

first column will remain the same. that is the tracker column (edit version) for the worksheet

 

[Yongle]

Place all the code in the same NEW module and etst it
Let me know how you get on

Option Explicit

Private Master As ListObject, M As Range, cM As Long
Private Tbl As ListObject, T As Range, cT As Long
Dim c As Long, ws As Worksheet

Sub AdjustTables()
'Master Table
    Set Master = Sheets("Template").ListObjects("tTemplate")
    Set M = Master.Range
    cM = M.Columns.Count
'loop sheets
For Each ws In ThisWorkbook.Sheets
    If ws.ListObjects.Count > 0 Then
        Set Tbl = ws.ListObjects(1)
        Set T = Tbl.Range
        cT = T.Columns.Count
       
        Select Case ws.Name
            Case "Template", "Sheet1", "Sheet2"             'list sheets to be ignored separated by commas
                'do nothing
            Case Else
                If cM > cT Then InsertColumn Else DeleteColumn
        End Select
    End If
Next ws
End Sub

Private Sub InsertColumn()
    For c = 2 To cM
        If WorksheetFunction.CountIf(Tbl.HeaderRowRange, M(1, c)) = 0 Then
'insert the column and reset the range
            If c > cT Then Tbl.ListColumns.Add Else Tbl.ListColumns.Add Position:=c
            Set T = Tbl.Range
'format the column
            T.Columns(c).ColumnWidth = M.Columns(c).ColumnWidth
            Tbl.HeaderRowRange(c) = Master.HeaderRowRange(c)
            Tbl.ListColumns(c).DataBodyRange.NumberFormat = M(2, c).NumberFormat
'add formula if appropriate
            On Error Resume Next
                If M(2, c).HasFormula Then Tbl.ListColumns(c).DataBodyRange.Formula = M(2, c).Formula
                If Err.Number <> 0 Then GoTo Handling:
            On Error GoTo 0
            Exit For
        End If
    Next c
Exit Sub
Handling:
MsgBox "Unable to create formula " & vbCr & M(2, c).Formula & vbCr & "in sheet " & T.Parent.Name, vbExclamation, ""
End
End Sub
Private Sub DeleteColumn()
    For c = 2 To cT
        If WorksheetFunction.CountIf(Master.HeaderRowRange, T(1, c)) = 0 Then
            Tbl.ListColumns(c).Delete
            Exit For
        End If
    Next c
End Sub