building shopping list

[ajm]

Folks, I have built a sort of meal planner for home. all our frequent recipes are in a workbook. on the first tab of the workbook, I have added a hyperlinked table of contents to make it easier to navigate to particular meals to see ingredients. taking it one step further, i wish to be able to select the recipes that we want for the week on this Table of Contents tab, and have a macro copy each recipe's ingredients to a separate tab. From this other tab, I will create a shopping list.

If the list of recipes is in Column A on TOC sheet (each entry in column a is the sheet name), and the number of people home for the week is in column D (we will use this number as the selection mark), how do i get a macro to copy the ingredients for each recipe to a new tab, "Weekly Ingredients". Each time a number is found, the ingredients will be copied to the next available line on the Weekly Ingredients tab.

Cheers

 

[ajm]

Bump

 

[ajm]

ok. ron de bruin has a a merge macro on his site at Merge cells from all or some worksheets into one Master sheet which I am going to attempt to modify for my purposes. It copies all sheets in the workbook onto a Merged Sheet. there are options for tweaking the macro on his page.

so now, all i am struggling with is the part of the code that will limit the worksheets merged to only those selected on my title page.

 

[alansidman]

Difficult to provide a solution without seeing a Before and After Scenario. Would be helpful if you could post to a third party site a workbook (small number of sheets) showing same. Mock up the after so we have a good idea of your needs.

 

[ajm]

fair comment Alan. I actually have worked out the code for myself. as with all projects, i have now a new problem which I didn't foresee when mapping out my approach. Don't you hate that.

restating my original problem: my code needed to:

look at the Index Sheet for recipes (Column A) which have a number against them in column D
Sheet names are Recipe names
for those recipes that are marked, copy the particular range which holds the ingredients from that recipe's tab to the ShoppingList (this was "Weekly Ingredients" originally) tab

Code that works, with many thanks to Ron De Bruin for the basis of this piece:

Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet, TitleSh As Worksheet
    Dim Last As Long, TitleLastRow As Long
    Dim CopyRng As Range, IndexRng As Range, rngCopy1 As Range, rngTarget1 As Range
    Dim Excludedsheets As Variant
    Dim x As Variant
    Dim l As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Delete the sheet "ShoppingList" if it exists
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("ShoppingList").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Identify Dest sheet Shopping List
    Set DestSh = ActiveWorkbook.Worksheets.Add
    
    Set rngCopy1 = ActiveWorkbook.Worksheets("LUps").Range("Headers")
        
    'rngcopy.Select
        
    Set rngTarget1 = DestSh.Range("A1")

    rngCopy1.Copy Destination:=rngTarget1
    Application.CutCopyMode = False
    
    With DestSh
        .Name = "ShoppingList"
    End With
    
    
    Set TitleSh = ActiveWorkbook.Worksheets("Index Sheet")

    With TitleSh

        TitleLastRow = .Cells(.Rows.Count, "a").End(xlUp).Row

        Set IndexRng = .Range("A2:A" & TitleLastRow)

    End With
    'loop through all recipes in list and copy the data to the DestSh
    'For Each sh In ActiveWorkbook.Worksheets
    For Each cel In IndexRng
    
        'MsgBox cel.Offset(, 3).Value
          
        If cel.Offset(, 3).Value <> "" Then

            'Find the last row with data on the DestSh
            Last = LastRow(DestSh)

            'Fill in the range that you want to copy
            Set CopyRng = ActiveWorkbook.Worksheets(cel.Value).Range("s16:z62")

            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If

            'This example copies values/formats, if you only want to copy the
            'values or want to copy everything look at the example below this macro
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

            'Optional: This will copy the sheet name in the H column
            DestSh.Cells(Last + 1, "I").Resize(CopyRng.Rows.Count).Value = cel.Value

        End If
    Next

ExitTheSub:

    Application.GoTo DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 
Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function