Auto creating tables on different sheets from a master sheet

[Jager819]

Hey everyone I want to create a workbook that keeps track of certifications of employees across different shifts. My goal is to have a master sheet that i update and have excel create tables in new tabs for each shift. I need the table to update when i change something in the master sheet. Bellow is an simplified version of what i want to do i will be keeping track of around 50 people and around 30 certifications. what would be the best way to do this i would eventually like to create charts that illustrate things like shifts completion percentage for each tool set but i will cross that bridge when i come to it. I just want to make sure that everything will work together in the future.

Employee	Shift	Badges	Task	Tool type	Certification
john	1	yes	1c		yes
Rob D.	2	yes	1a		yes
Rob D.	2	yes	2a		no
Tom	2	yes	1a		no
Joe	3	yes	1a		yes

<tbody>
</tbody>

Employee	Shift	Badges	Task	Tool Type	Certification
Rob D.	2	yes	1a		yes
Rob D.	2	yes	2a		no
Tom	2	yes	1a		no

<tbody>
</tbody>

 

[Yongle]

I have assumed that each shift sheet is IDENTICAL in every way to "Master" - it simply contains fewer rows

Instead of updating whenever an amendment is made, this method updates everything when you deactivate the Master Sheet
- it deletes all shift sheet cell contents and rebuilds

Additionally sub UpdateAllSheets can be run at any time.

I created 3 sheets named "1", "2" and "3" (your names may differ - see below), and sheet "Master" containing your data

To test, I suggest you
- create a new workbook with sheet named "Master" and three other sheets named "1", "2" and "3"
- paste your data into "Master" starting at cell A1
- add the code where indicated
- click on other 3 sheets
- add (or amend) data in "Master" and click on the other 3 sheets

Adapt the code to match your specific requiremts only after you have proven that the method is working!

Paste the first 2 procedures into a STANDARD module

Sub UpdateAllSheets()
    Dim ws As Variant
    For Each ws In Array("1", "2", "3")
        Call SelectShiftData(Sheets(ws))
    Next
End Sub

Sub SelectShiftData(ShiftSheet As Worksheet)
    Application.ScreenUpdating = False
    On Error Resume Next
    ShiftSheet.Cells.ClearContents
    With Sheets("Master").Range("A1").CurrentRegion
        .AutoFilter = False
        .AutoFilter Field:=2, Criteria1:=ShiftSheet.Name
        .Copy ShiftSheet.Range("A1")
        .Parent.ShowAllData
    End With
    Application.CutCopyMode = False
    With ShiftSheet.Range("A1").CurrentRegion
        .AutoFilter = True
        .Cells(1).Activate
    End With
    Application.ScreenUpdating = True
End Sub

Paste code below into the SHEET module for "Master"

Private Sub Worksheet_Deactivate()
    Call UpdateAllSheets
End Sub

Adding borders around data
When row numbers vary I prefer to use conditional formatting to put borders around cells - otherwise copy and pasting leaves debris behind
- in all 4 sheets (separately)
- select columns A to F
- added a CF rule to insert all borders
- with formula =$A1>""
- which basically adds a border if there is a value in column A
- when cell values are cleared the border simply vanishes

Different sheet names - the code needs modification to use sheet names other than "1", "2" and "3"
As an example - if your sheets are named "Shift1", "Shift2", "Shift3" and column B values are "1", "2" or "3" then these are the amended lines

.AutoFilter Field:=2, Criteria1:=[COLOR=#000080]Right(ShiftSheet.Name, 1)[/COLOR][B]

AND[/B]

For Each ws In Array([COLOR=#000080]"Shift1", "Shift2", "Shift3"[/COLOR])

Let me know how you get on

 

[Jager819]

Thank you for the help. the test worked great now i just need to adapt it for my data if i added or removed columns will this still work?

 

[Jager819]

Ok so i may need some help my sheet names are going to be Demo, Shift1, Shift4, Shift5, Shift6, and Shift7. Values will be Demo, 1, 4, 5, 6, and 7. I have made the following changes but it comes up with an error

For Each ws In Array("Demo", "Shift1", "Shift4", "shift5", "Shift6", "Shift7")
Call SelectShiftData(Sheets(ws))

.AutoFilter Field:=2, Criteria1:=(ShiftSheet.Name,1)

 

[Yongle]

Somehow you need to link the sheet name to what is in column 2
- if there is a consistent pattern it is easy but that no longer seems to be the case
- why have you named a shift "Demo" ? Is that a genuine used name for one of your shifts?
(Demo breaks the pattern)

Is there a reason why shifts 2 and 3 are not listed?
Are you likely to need to go beyond 9 shifts?

The easiest way to sort it would be to have values in column B exactly the same as the sheet name (Demo, Shift1..etc)
Failing that, the next choice would be a consistent pattern so that there is always a number in column B that needs to be added to "Shift" to give us the sheet name (every sheet needs to match the pattern otherwise this becomes messy and we have to build in exceptions etc)
Failing that, we need to tell VBA sheet by sheet which value to grab - we simply create a one-to-one table of values

Let me know which way you want to go and I will update the code tomorrow to provide the flexibility required.
thanks

 

[Yongle]

I was being a bit slow last night - I could not see the obvious easy way to keep everything simple
A new day, a functioning brain...

Solution
Name every sheet "Shift" followed by the value you want in Column B

The array contains the list of sheets (all of which begin with the word "Shift")

For Each ws In Array("Shift1", "Shift2", "Shift3", "ShiftData")

The criteria is generated by removing "Shift" from the beginning of each sheet name

Criteria1:=Replace(ShiftSheet.Name, "Shift", "")

Sub SelectShiftData(ShiftSheet As Worksheet)
    Application.ScreenUpdating = False
    On Error Resume Next
    ShiftSheet.Cells.ClearContents
    With Sheets("Master").Range("A1").CurrentRegion
        .AutoFilter = False
        [COLOR=#ff0000].AutoFilter Field:=2, Criteria1:=Replace(ShiftSheet.Name, "Shift", "")[/COLOR]
        .Copy ShiftSheet.Range("A1")
        .Parent.ShowAllData
    End With
    Application.CutCopyMode = False
    With ShiftSheet.Range("A1").CurrentRegion
        .AutoFilter = True
        .Cells(1).Activate
    End With
    Application.ScreenUpdating = True
End Sub

Sub UpdateAllSheets()
    Dim ws As Variant
    [COLOR=#ff0000]For Each ws In Array("Shift1", "Shift2", "Shift3", "ShiftData")[/COLOR]
        Call SelectShiftData(Sheets(ws))
    Next
End Sub

Note
If you do not want to name the sheet ShiftData, then the workaround would be to rename whilst the code runs, like this

Sub UpdateAllSheets()
    Dim ws As Variant
    [COLOR=#000080]Sheets("Data").Name = "ShiftData"[/COLOR]
        For Each ws In Array("Shift1", "Shift2", "Shift3", "ShiftData")
            Call SelectShiftData(Sheets(ws))
        Next
    [COLOR=#000080]Sheets("ShiftData").Name = "Data"[/COLOR]
End Sub

 

[Jager819]

Thanks for your help again this seems to work