Creating a updating master list from multiple tables

It would be better if you formatted the costs sheet and put some actual data for a couple of days on there so we can see what you want it to look like.

Having it update automatically might make it run slow.


If the code has to loop through all the sheets every time you change an item, add an item, delete an item, change the quantity, then you might see a noticeable lag, maybe not, but I'm just letting you know.

It might be better to have an update button or just run the macro from a key combination like Control + q.

There's a difference between an actual "Table" in Excel and what a lot of people call tables.

What you have on the sheet labeled "Preflight" is an actual table.

What you have on your day sheets are not tables, they are just formatted to look like tables.

Life would be a whole lot easier if they were all tables and only had actual data. In other words if there's no data entered it's just a header and one blank row, not a bunch of blank rows with the day numbers entered. No extra rows where the activity is blank. Coding for actual tables is much easier than having to figure out where the data is in ranges.

If the name of the tables were simply the days "Day 1" etc this would also make things very easy.

The table on your costs sheet doesn't make sense to me, your day tabs have "Day", "Activity", "Cost", "Comment" what you made has names and no example data that I asked for.

If you want to make the necessary changes I'm willing to help you.

You make and name the tables, make the costs table and I'll code it.

It's a little late so it'll probably be some time tomorrow.
I hope that's not a big issue.

Okay, here we go.

I updated all your formulas to work with the tables.

I added the name "Conversion" to the name manager.
This is for the 1.48 you are using in your formulas to convert English pounds to U.S. dollars. So if you look at all you formulas you will see the word "Conversion" in them. If by chance you want to change the 1.48 to some other factor you can do this in the name manager one time and all your formulas will update. It's much better than having to go to every formula and change the 1.48 to something else.

Test it out and let me know.

I'm posting the code below for those who don't want to open the spreadsheet.
The attached file has the code installed.

I put a button on the costs sheet, but the code runs pretty fast.

We could have the code run anytime you switch over to the costs sheet, you would probably see one quick little flicker as the code runs, but as I said it's pretty fast.

Sub ClearCostsTable()
Dim tbl As ListObject
Set tbl = Worksheets("Costs").ListObjects("Costs")
    If tbl.ListRows.Count >= 1 Then
        tbl.DataBodyRange.Delete
    End If
End Sub

Sub LoopAllTables()
ClearCostsTable
Application.ScreenUpdating = False
Dim tbl As ListObject, tblCosts As ListObject
Dim ws As Worksheet, wsCosts As Worksheet, c As Long: c = 0
Set wsCosts = Worksheets("Costs"): Set tblCosts = wsCosts.ListObjects("Costs")
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name Like "Day" & "*" Then
            For Each tbl In ws.ListObjects
                If tbl.ListRows.Count = 0 Then GoTo 1
                    With tbl.DataBodyRange
                            If c = 0 Then
                                .Copy tblCosts.HeaderRowRange.Offset(1)
                            Else
                                .Copy tblCosts.DataBodyRange.Rows(c)
                            End If
                        c = tblCosts.DataBodyRange.Rows.Count + 1
                     End With
1          Next tbl
        End If
    Next ws
    tblCosts.Range.ClearFormats
    tblCosts.TableStyle = "TableStyleMedium21"
Application.ScreenUpdating = True
End Sub

Well if you don't want zeros in costs, that's one click in the filtering and if you don't want blanks in costs that's another click, but I can pre-click with code.

Option Explicit

Sub ClearCostsTable()
Dim tbl As ListObject
Set tbl = Worksheets("Costs").ListObjects("Costs")
    If tbl.ListRows.Count >= 1 Then
    tbl.DataBodyRange.AutoFilter 3
        tbl.DataBodyRange.Delete
    End If
End Sub

Sub LoopAllTables()
ClearCostsTable
Application.ScreenUpdating = False
Dim tbl As ListObject, tblCosts As ListObject
Dim ws As Worksheet, wsCosts As Worksheet, c As Long: c = 0
Set wsCosts = Worksheets("Costs"): Set tblCosts = wsCosts.ListObjects("Costs")
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name Like "Day" & "*" Then
            For Each tbl In ws.ListObjects
                If tbl.ListRows.Count = 0 Then GoTo 1
                    With tbl.DataBodyRange
                            If c = 0 Then
                                .Copy tblCosts.HeaderRowRange.Offset(1)
                            Else
                                .Copy tblCosts.DataBodyRange.Rows(c)
                            End If
                        c = tblCosts.DataBodyRange.Rows.Count + 1
                     End With
1          Next tbl
        End If
    Next ws
    tblCosts.Range.ClearFormats
    tblCosts.TableStyle = "TableStyleMedium21"
    FilterCosts
Application.ScreenUpdating = True
End Sub

Sub FilterCosts()
Application.ScreenUpdating = False
Dim tblCosts As ListObject
Dim wsCosts As Worksheet
Set wsCosts = Worksheets("Costs")
Set tblCosts = wsCosts.ListObjects("Costs")
    With tblCosts.DataBodyRange
        .AutoFilter 3, "<>"
        .AutoFilter 3, ">0"
    End With
Application.ScreenUpdating = True
End Sub

My apologies.

I probably looked at that ten times during testing and it never registered.

Have a great trip.

Try this.

Bruce(skywriter).