Thread: creates a filter and copies to new workbook, want user to select filter

I've got a workbook with around 3000 lines of data, i'ver created a macro that filters under product list and then copies the the data to a new workbook.

Macro that i have does that ok, what i'm trying to now do is to allow the user to select the filter somehow ie. userform and then select products(s) that they wish to be including in the new workbook.

Not sure what the best way to do this is? any advise appreciated?

Current code below, i've also attached a santised workbook

Sub CreateFilter()
'
' CreateFilter Macro

    Dim FinalRowSD As Integer    'Count last row in MI&SD Tracking.xlsm
    Dim FinalRowNew As Integer 'Count last row in New Workbook
    Dim PickFilter As String ' filter Product name
      
    Application.ScreenUpdating = False
    
    'Select Filter and copy filtered cells
    With Workbooks("MI&SD Tracking1.xlsm").Worksheets("SD Raw Data")
             
        'Find last row
        FinalRowSD = .Range("A" & Rows.Count).End(xlUp).Row
            
            With ActiveSheet.ListObjects("Table3").Range

                ' Clear all filters
                .AutoFilter Field:=1
                .AutoFilter Field:=2
                .AutoFilter Field:=3
                .AutoFilter Field:=4
                .AutoFilter Field:=7
                .AutoFilter Field:=8
                .AutoFilter Field:=9
                .AutoFilter Field:=10
                .AutoFilter Field:=11
                
                
                'Filter Selection Criteria
                .AutoFilter Field:=2, Criteria1:="blackberry"
            End With
        'Select All rows with data and copy
        Range("A1:L" & FinalRowSD).Select
        Selection.Copy
    End With
    
    Workbooks.Add
    
        With ActiveSheet
            'Paste Values to A1 Including heading
            .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            'Find last row
            FinalRowNew = .Range("A" & Rows.Count).End(xlUp).Row
            'Select colums to format Day As Monday
            Columns("I:I").Select
            Application.CutCopyMode = False
            Selection.NumberFormat = "dddd"
            
            'Select Column to format as Oct-11
            Columns("K:K").Select
            Selection.NumberFormat = "mmm-yy"
            Columns("H:H").Select
            Selection.NumberFormat = "m/d/yyyy"
            'Select all rows to make a table and do not style it
            Range("A1:L" & FinalRowNew).Select
            'ActiveSheet
            .ListObjects.Add(xlSrcRange, Range("$A$1:$L$" & FinalRowNew), , xlYes).Name = "Table1"
            Range("Table1[#All]").Select
            'ActiveSheet
            .ListObjects("Table1").TableStyle = ""
            Range("A1").Select
        End With
        
        'Rename sheets
        Sheets("Sheet2").Name = "Data Analysis"
        Sheets("Sheet3").Name = "Presentation"
        
    
    With Workbooks("MI&SD Tracking1.xlsm").Worksheets("SD Raw Data").Activate
    
        With ActiveSheet.ListObjects("Table3")
        .Range.AutoFilter Field:=2
        End With

    End With
    
    Application.ScreenUpdating = True
    
End Sub

Hi delboy2405
Try the code in the attached. Let me know of issues.

PS: Sorry, I forgot to make the Named Range "Products" Dynamic. If you need help with that let me know.

Hi delboy2405

Have to be honest with you, what I know (which is not a lot compared to the talent on this Forum) I've learned by doing and by doing Google searches. I have one book to which I refer not often...John Walkenbach's Excel 2007 Power Programming with VBA.

There is a Thread in this Forum that has many, many references to Resource Materials but I couldn't find it tonight to give you a reference...sorry. Good luck and good hunting.