Filter data from a master to multiple sheets + appending lists

[nomwich]

I'm trying to streamline a workbook so that all data is entered in one spot that then auto-populates several other sheets with filtered results, based on the criteria of lists that may change over time.

Using the example I attached:
- The user enters line items in the master. Type is selected from a drop-down list. That drop-down needs to populate from three separate lists on a different sheet.
- Then, depending on the type of a record, each record then populates three other 'result' sheets.
- Ideally, each 'result' sheet should update automatically as the user enters results on the Master sheet. Likewise, the Type drop-down list should be able to change as items are added to it.

I've included my example. Please feel free to ask me any questions if you think you can help:

Meal Schedule.xlsx

[jaslake]

Hi nomwich
I'd think you'll need some VBA Code to accomplish all of this. Are you open to that? If so, can your Codes Worksheet be structured differently?

[nomwich]

Hi nomwich
I'd think you'll need some VBA Code to accomplish all of this. Are you open to that? If so, can your Codes Worksheet be structured differently?

Yes to all of the above. Do I need to change the Codes sheet, or did you have something in mind?

[jaslake]

Hi nomwich

I'll look at the Code Sheets and make recommended changes.

[jaslake]

Hi nomwich

This Code is in the attached:

In Sheet Master

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LR As Long
    Dim c As Range, rng As Range
    Dim mySheet As String
    If Not Target.Column = 5 Then Exit Sub
    If Target.Address = "$E$1" Then Exit Sub

    Application.ScreenUpdating = False

    Set rng = Sheets("Codes").Range("Name")
    Set c = rng.Find(Target.Value, LookIn:=xlValues)
    mySheet = c.Offset(0, 1).Value

    With Sheets(mySheet)
        LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row + 1
        .Cells(LR, "A").Value = Target.Offset(0, -3).Value
        .Cells(LR, "B").Value = Target.Value
        .Cells(LR, "C").Value = Target.Offset(0, -1).Value
        .Cells(LR, "E").Value = Target.Offset(0, -4).Value
    End With
    Application.ScreenUpdating = True
End Sub

In Sheet Codes

Option Explicit

Sub Sort_Codes()
    Dim ws As Worksheet
    Dim LR As Long

    Set ws = Sheets("Codes")
    With ws
        LR = .Range("F" & .Rows.Count).End(xlUp).Row
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("G2:G" & LR), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("F2:F" & LR), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ws.Sort
            .SetRange Range("F1:G" & LR)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub

To view the Code Right Click on the Sheet Tab ---> View Code.

The Code in Sheet Master runs when the Value in Column E changes.

The Code in Sheet Codes runs when you click the Button.

Any Items you add to Sheet Code will be automatically added to the Drop Down because I've added a Dynamic Named Range that populates the Data Validation for the Drop Down.

I've changed the Structure of Sheet Codes and I've changed the Column Layout of Sheet Master.

Let me know of issues...

[nomwich]

Holy cow! This is soooooooo cool.

So, a few points. For each of the individual sheets, I meant for the "Status" column to display the "Type". That's a mislabel on my part, so my fault. Sorry.

Everything works great. The only thing I noticed is that it doesn't remove items from the individual sheets. Meaning, when you select a type from drop-down list (on a new record or one that's already been entered), it adds the record to the individual list, but if you happen to change it, it adds the item again to the same sheet, or another depending on what's selected. I need for the individual sheets to act as a filter of the master sheet, displaying only that which applies to the sheet ('Fruit' only shows the fruit entries, if there are any to show). Is that a big change? It's bleeping incredible though.

[jaslake]

Hi nomwich

I've modified the Code somewhat to anticipate multiple Change Events.

This has been handled, I believe

when you select a type from drop-down list (on a new record or one that's already been entered), it adds the record to the individual list, but if you happen to change it, it adds the item again to the same sheet, or another depending on what's selected

It's been handled by adding a Helper Column G to each Sheet. Notice the Formula in Column G. They are all the same EXCEPT for Master. These Column can be hidden (or the Font made white). I selected G because it's available in your Sample File...it can be anywhere.

I'm not certain all is handled because I'm not certain what this means

I need for the individual sheets to act as a filter of the master sheet

But this appears to be happening

displaying only that which applies to the sheet ('Fruit' only shows the fruit entries, if there are any to show).

Let me know of issues.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LR As Long
    Dim c As Range, rng As Range
    Dim mySheet As String, OldValue As String, OldCat As String, NewValue As String, NewCat As String
    '    If Not Target.Column = 5 Then Exit Sub
    If Target.Row = 1 Then Exit Sub

    If Target.Column = 5 Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .Undo
            OldValue = Target.Cells(1).Value  'store old name
            .Undo
            NewValue = Target.Cells.Value     'store new name

            .Undo
            OldCat = Target.Cells(1).Offset(0, 2).Value    'store old name
            .Undo
            NewCat = Target.Cells.Offset(0, 2).Value    'store new name

        End With

        Set rng = Sheets("Codes").Range("Name")
        Set c = rng.Find(Target.Value, LookIn:=xlValues)
        mySheet = c.Offset(0, 1).Value

        With Sheets(mySheet)
            LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious).Row + 1
            .Cells(LR, "A").Value = Target.Offset(0, -3).Value
            .Cells(LR, "B").Value = Target.Value
            .Cells(LR, "C").Value = Target.Offset(0, -1).Value
            .Cells(LR, "E").Value = Target.Offset(0, -4).Value
            .Cells(LR, "D").Value = mySheet
        End With
        If Not OldValue = "" Then
            Set c = rng.Find(OldValue, LookIn:=xlValues)
            mySheet = c.Offset(0, 1).Value
            With Sheets(mySheet)
                Set c = .Columns(7).Find(OldCat, LookIn:=xlValues)
                '            Application.Goto c, True

                .Rows(c.Row).EntireRow.Delete Shift:=xlUp
            End With
        End If
    End If

    If Target.Column = 1 Or Target.Column = 2 Or Target.Column = 4 Then
        If Not IsEmpty(Cells(Target.Row, "E").Value) Then
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
                .Undo
                OldCat = .Cells(Target.Row, "G").Value   'store old name
                .Undo
                NewCat = .Cells(Target.Row, "G").Value   'store new name
            End With
            Set rng = Sheets("Codes").Range("Name")
            Set c = rng.Find(Cells(Target.Row, "E").Value, LookIn:=xlValues)
            mySheet = c.Offset(0, 1).Value
            With Sheets(mySheet)
                Set c = .Columns(7).Find(OldCat, LookIn:=xlValues)
                .Cells(c.Row, "G").Value = NewCat
            End With
        End If
    End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

[nomwich]

I actually been working on my own version after learning some new tricks. I'll show you as soon as I'm done, but I believe I may have solved my problem(s). I'll show you tomorrow!

[nomwich]

Alright. So I took some of your code and some other code I found online and have been tweaking it (after learning what I have about these functions). I pretty much have it down. The Update_Lists macro does the filtering. The Update_Statuses updates and sorts the lists that will be used for filtering. I'm still trying to find the best way to create dynamic named ranges for the lists that can then be referenced for the AdvancedFilter's CriteriaRange in Update_Lists. Yes, this is a bit of a departure from what we had originally been working on, but I failed to mention the necessity for separate lists and for the constant updating of the filtered sheets:

Sub Update_Lists()
Dim ws As Worksheet

Set ws = Worksheets("Meals")
With ws
  .Range("A1:M" & Rows.Count) _
    .AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=Sheets("Codes").Range("C1:C" & Rows.Count), _
      CopyToRange:=Sheets("Fruits").Range("A1:M1"), Unique:=False
  .Range("A1:M" & Rows.Count) _
    .AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=Sheets("Codes").Range("A1:A" & Rows.Count), _
      CopyToRange:=Sheets("Veggies").Range("A1:M1"), Unique:=False
  .Range("A1:M" & Rows.Count) _
    .AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=Sheets("Codes").Range("B1:B" & Rows.Count), _
      CopyToRange:=Sheets("Meats").Range("A1:M1"), Unique:=False
  .Range("A1:M" & Rows.Count) _
    .AdvancedFilter Action:=xlFilterCopy, _
' This is where I am having a problem trying to figure out how to cull out those
' records that do not fit any of the previous ranges. D1:D# has the full list of all possible meals
      CriteriaRange:=Sheets("Codes").Range(Not (ISEQUALS("D1:D" & Rows.Count))), _
      CopyToRange:=Sheets("!Errors!").Range(" A1:M1"), Unique:=False
End With
End Sub

Sub Update_Statuses()
    Dim ws As Worksheet
    Dim LR As Long
    Dim MR As Long
    Dim NR As Long
    Dim PR As Long
    
    Set ws = Sheets("Codes")
    With ws
        PR = .Range("D" & Rows.Count).End(xlUp).Row
        Range("D2:D" & PR).ClearContents
        LR = .Range("A" & Rows.Count).End(xlUp).Row
         .Sort.SortFields.Clear
         .Sort.SortFields.Add Key:=Range("A1:A" & LR), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ws.Sort
            .SetRange Range("A1:A" & LR)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        Range("D2:D" & LR).Value = _
        Range("A2:A" & LR).Value
        
        MR = .Range("B" & Rows.Count).End(xlUp).Row
         .Sort.SortFields.Clear
         .Sort.SortFields.Add Key:=Range("B1:B" & MR), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ws.Sort
            .SetRange Range("B1:B" & MR)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        MR = .Range("B" & Rows.Count).End(xlUp).Row
        Range("D" & (LR + 1) & ":D" & (LR + MR - 1)).Value = _
        Range("B2:B" & MR).Value
        
        NR = .Range("C" & Rows.Count).End(xlUp).Row
                 .Sort.SortFields.Clear
         .Sort.SortFields.Add Key:=Range("C1:C" & NR), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ws.Sort
            .SetRange Range("C1:C" & NR)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        NR = .Range("C" & Rows.Count).End(xlUp).Row
        Range("D" & (LR + MR) & ":D" & (LR + MR + NR - 2)).Value = _
        Range("C2:C" & NR).Value
    End With

End Sub

I realize this is long and meaningless without the sheet. I'll post a copy as soon as it's cleaned up. I messed it up a bit trying stuff out. :D

[jaslake]

Keep me posted...I've developed a different approach also...please answer this question

Will you want/need the ability to add additional Categories in addition to Fruit, Meat and Veggie?

[nomwich]

Keep me posted...I've developed a different approach also...please answer this question

I will not.

[jaslake]

May I ask why not?

Sorry, I may have misunderstood...You will Not answer the question ... or you won't have the Need to add additional Categories.

[nomwich]

LOL! I will not have the need for additional categories. Or more specifically, I'd rather not even consider the issue of having more categories.

Quick question though. Is there a way to specify for the range, in the following example, to NOT be "Drop_Down"? (as in, the criteria should be everything that is not identify in the range "Drop_Down")

  .Range("A1:M" & Rows.Count) _
    .AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=Sheets("Codes").Range("Drop_Down"), _
      CopyToRange:=Sheets("!Errors!").Range("A1:M1"), Unique:=False

[jaslake]

Hi

All is out of context and I can't test this but it would be something like

.Range("A1:M" & Rows.Count) _
    .AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:="<>" & Sheets("Codes").Range("Drop_Down"), _
      CopyToRange:=Sheets("!Errors!").Range("A1:M1"), Unique:=False

[nomwich]

I've opted against the error checking sheet. Too much work.

That being said, is there a way to ensure that .AdvancedFilter copies and pastes formulas contained in cells and not just values?