Consulting

Results 1 to 10 of 10

Thread: MACRO filter column based on reference criteria copy, paste and repeat

  1. #1

    Lightbulb MACRO filter column based on reference criteria copy, paste and repeat

    Hi everyone, I've been working on this problem for quite some time now and I'm stuck. Hoping this community can provide some very needed guidance to this newbie

    I've attached a simple workbook. I'd like to filter Column A on Data1 based on the Names tab, paste into PasteData1, and do the same for Data2 - PasteData2 and Data3 - PasteData3, then save down a copy of the workbook with the Name.xlsx and loop to the next name. So the process is this:


    Filter Data1 for the first Name on the Names tab
    Paste those values onto PASTEData1 tab
    Filter Data2 for the first Name on the Names tab
    Paste those values onto PASTEData2 tab
    Filter Data3 for the first Name on the Names tab
    Save down the workbook as Name.xlsx
    Repeat for Name 2 on the Names tab


    To note, the three data tabs cannot be combined into 1, my actual workbook is more complicated.

    Please help!
    Attached Files Attached Files

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    It's probably quite easy to write a macro to remove names from Data1, Data2 etc. which aren't the one you want to keep each time and do away with PasteData1, PasteData2 sheets. Would that be allowed?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    Yes that's a good point. I wasn't sure if the paste tabs would make things easier or not. How could I go about that?

  4. #4
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    In the meantime I wrote the beginnings of a macro to carry out your original idea:
    Sub blah()
    With Sheets("Names")
      Set rngListOfNames = .Range(.Range("A1"), .Range("A1").End(xlDown))
      Set rngListOfNames = Intersect(rngListOfNames, rngListOfNames.Offset(1))
      'Application.Goto rngListOfNames
      Set rngCriteria = .UsedRange.Offset(, .UsedRange.Columns.Count + 1).Resize(2, 1)
      'Application.Goto rngCriteria
      rngCriteria.Cells(1).Value = "Name"
    End With
    Set SourceSheets = Sheets(Array("Data1", "Data2", "Data3"))
    Set DestnSheets = Sheets(Array("PASTEData1", "PASTEData2", "PASTEData3"))
    For Each cll In rngListOfNames.Cells
      rngCriteria.Cells(2).Value = cll.Value
      For i = 1 To SourceSheets.Count
        'DestnSheets(i).Activate
        DestnSheets(i).Range("A1").CurrentRegion.Clear
        SourceSheets(i).Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCriteria, CopyToRange:=DestnSheets(i).Range("A1"), Unique:=False
      Next i
      'Stop
      'Save the file here using the name in cll.value
      MsgBox "Save here using a name like" & ThisWorkbook.Path & Application.PathSeparator & cll.Value & ".xlsm"
    Next cll
    rngCriteria.Clear
    End Sub
    I've just put a message box instead of actually saving the file because how the file is saved depends on what you want saved in these new files; for example, do you want the macros to be included in the file, do you want the Names sheet to be included too? I'd have guessed not, especially if you're sending these files out to people, you might only want to send out a small subset of the sheets, which would actually be easier to code for.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  5. #5
    Thank you so much! I will try this out.

    For this approach, I'd like to save the file with the Name that was filtered ie Name.xlsx and keep everything in the workbook.

    In my actual workbook I have 6 summary sheets that are driven off of the Data (or PasteData tabs). My plan was to create another macro that will run through all the files select just those 6 sheets, copy paste value, and save it down.

  6. #6
    How do I go about replacing the message box with the Name.xlsx so I can see how it's working?

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    There are problems with saving a copy of the file which has the macros in as an xlsx file (without macros), a bit convoluted. I would much prefer to create a separate workbook (.xlsx) for each name and paste copies of the sheets to it, that way you wouldn't need to create a second macro to run through the files again.
    So it's just all the Datan sheets and the corresponding PASTEDatan sheets that need to be in the final files?
    Bedtime here. I'll revisit tomorrow or the day after.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #8
    Saved as a macro file is fine as well. But what you suggest works too. If you wouldn't mind, how to replace the message box with the Name. xlsm? Thank you for your help.

  9. #9
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Try:
    Sub blah()
    On Error GoTo errhanldler
    Application.ScreenUpdating = False
    With Sheets("Names")
      Set rngListOfNames = .Range(.Range("A1"), .Range("A1").End(xlDown))
      Set rngListOfNames = Intersect(rngListOfNames, rngListOfNames.Offset(1))
      Set rngCriteria = .UsedRange.Offset(, .UsedRange.Columns.Count + 1).Resize(2, 1)
      rngCriteria.Cells(1).Value = "Name"
    End With
    Set SourceSheets = Sheets(Array("Data1", "Data2", "Data3"))    'adjust this line if necessary.
    Set DestnSheets = Sheets(Array("PASTEData1", "PASTEData2", "PASTEData3"))    'adjust this line if necessary.
    For Each cll In rngListOfNames.Cells
      rngCriteria.Cells(2).Value = cll.Value
      For i = 1 To SourceSheets.Count
        DestnSheets(i).Range("A1").CurrentRegion.Clear
        SourceSheets(i).Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCriteria, CopyToRange:=DestnSheets(i).Range("A1"), Unique:=False
      Next i
      DestnSheets.Copy
      With ActiveWorkbook
        Application.DisplayAlerts = False    'omit this line if you want to be asked about overwriting an existing file.
        .SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & cll.Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        Application.DisplayAlerts = True
        .Close
      End With
    Next cll
    For Each sht In DestnSheets
      sht.UsedRange.Clear
    Next sht
    rngCriteria.Clear
    errhanldler:
    Application.ScreenUpdating = True
    End Sub
    Last edited by p45cal; 01-27-2020 at 04:41 AM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  10. #10
    Awesome, this worked perfectly thank you for your help!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •