Add data from sheets dynamically

[msbask]

In my example, I have a workbook that tracks information about fruit orders.

I have manually set up the TOTAL page to pull the data from the individual fruit sheets, which works fine. However, if I add another fruit worksheet, I have to manually add another column to the TOTAL page.

There must be a way to have the total page automatically recognize that a new sheet has been added and just include that automatically (and remove the column if the tab is removed), but I'm struggling to figure it out.

Note that there would likely never be more than 25 fruits, if that makes a difference.

Thanks for any help!

fruits.xlsx
	A	B	C	D
1	Fruit:	Apple	Banana	Orange
2	Quantity:	648	449	140
3	Source:	New Zealand	Mexico City	Palm Beach
4	Next Order:	44986	45063	44992
5	Servicer:	Mandalarin Corp.	Therango Brothers Co.	Orenson Inc.
6	Account #:	314469-BK	359126-RM	703816-RM
TOTAL

Cell Formulas
Range	Formula
B1:B6	B1	=Apple!B1
C1:C6	C1	=Banana!B1
D1:D6	D1	=Orange!B1

 

[mumps]

Start with only column A populated in the TOTAL sheet. You will not need any formulae. Then copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your TOTAL sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Click on the name of the last sheet in your workbook and then click the plus sign to add a new sheet. Double click the new sheet name to re-name it with the name of the fruit. Insert the fruit name in B1 and the additional data below it. When done, activate the TOTAL sheet and the new fruit data will be added automatically. If you want to delete a fruit, delete the desired fruit sheet. When you activate the TOTAL sheet, that fruit column will be deleted. Please note that the macro is executed each time the TOTAL sheet is activated.

Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, wsName As Range, lRow As Long, srcRng As Range, rng As Range, lCol As Long, desWS As Worksheet
    Set desWS = Sheets("TOTAL")
    lCol = desWS.Cells(1, desWS.Columns.Count).End(xlToLeft).Column
    If lCol > 1 Then
        Set srcRng = desWS.Range("B1").Resize(, lCol - 1)
        For Each ws In Sheets
            If ws.Name <> "TOTAL" Then
                Set wsName = srcRng.Find(ws.Name, LookIn:=xlValues, lookat:=xlWhole)
                If wsName Is Nothing Then
                    lRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    lCol = desWS.Cells(1, desWS.Columns.Count).End(xlToLeft).Column
                    desWS.Cells(1, lCol + 1).Resize(lRow).Value = ws.Range("B1").Resize(lRow).Value
                End If
            End If
        Next ws
    Else
       lRow = Sheets(2).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
       desWS.Cells(1, lCol + 1).Resize(lRow).Value = Sheets(2).Range("B1").Resize(lRow).Value
    End If
    lCol = desWS.Cells(1, desWS.Columns.Count).End(xlToLeft).Column
    Set srcRng = desWS.Range("B1").Resize(, lCol - 1)
    For Each rng In srcRng
        If Not Evaluate("isref('" & rng.Value & "'!A1)") Then
            rng.EntireColumn.Delete
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[James006]

Hi,
In cell B1, you can have

=IFERROR(INDEX(MID(sheetnames,FIND("]",sheetnames)+1,255),COLUMNS($B$1:B1)),"")

provided you have created a Named Range sheetnames .... defined as follows =GET.WORKBOOK(1)&T(NOW())

 

[msbask]

This is amazing and does exactly what I need it to do, except, if I change the number of apples, the TOTAL sheet doesn't update.

 

[mumps]

Try:

Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, wsName As Range, lRow As Long, srcRng As Range, rng As Range, lCol As Long, desWS As Worksheet
    Set desWS = Sheets("TOTAL")
    lCol = desWS.Cells(1, desWS.Columns.Count).End(xlToLeft).Column
    If lCol > 1 Then
        Set srcRng = desWS.Range("B1").Resize(, lCol - 1)
        For Each ws In Sheets
            If ws.Name <> "TOTAL" Then
                Set wsName = srcRng.Find(ws.Name, LookIn:=xlValues, lookat:=xlWhole)
                If wsName Is Nothing Then
                    lRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    lCol = desWS.Cells(1, desWS.Columns.Count).End(xlToLeft).Column
                    desWS.Cells(1, lCol + 1).Resize(lRow).Value = ws.Range("B1").Resize(lRow).Value
                Else
                    lRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    lCol = desWS.Cells(1, desWS.Columns.Count).End(xlToLeft).Column
                    desWS.Cells(2, lCol).Resize(lRow - 1).Value = ws.Range("B2").Resize(lRow - 1).Value
                End If
            End If
        Next ws
    Else
       lRow = Sheets(2).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
       desWS.Cells(1, lCol + 1).Resize(lRow).Value = Sheets(2).Range("B1").Resize(lRow).Value
    End If
    lCol = desWS.Cells(1, desWS.Columns.Count).End(xlToLeft).Column
    Set srcRng = desWS.Range("B1").Resize(, lCol - 1)
    For Each rng In srcRng
        If Not Evaluate("isref('" & rng.Value & "'!A1)") Then
            rng.EntireColumn.Delete
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[msbask]

Thanks so much!

 

[mumps]

My pleasure.