Need a macro to extract only rows of certain manufacturers from a big list

[Deafdog]

Running Windows 10 and Office 2019 Pro.

I have a spreadsheet from a distributor that has about 500K+ rows in it and about 2000 different manufacturers with part numbers, pricing, descriptions, etc.
I am only interested in some of the manufacturers but the supplier can only send me their entire list.

I would like to have a macro that pulls out all the rows from just the manufacturers I'm interested in and put the result in a new separate sheet in the same workbook
or into a new workbook/sheet would be fine.

I can explain it in words but have no idea how to compose a macro to do what I want

Let's say I have a workbook with just Sheet1 that has all the 500K+ rows and let's say column C is the name of the manufacturer.
A manufacturer could have many rows of data that belong to them and I'm only interested in some of the manufacturers and need to isolate and keep all their rows separately.

Then say the manufacturers names of interest are:

Manufacturer1
Manufacturer2
Manufacturer3
Manufacturer4
Manufacturer5

The macro would go through all the rows in Sheet 1 and put into a separate sheet (Sheet2) all the rows that match Manufacturer1-Manufacturer5 (Column C).
The original Sheet 1 would remain intact (no deletes).
The new Sheet2 would be the result and contain all the rows belonging to Manufactuer1-Manufacturer5.
For the future I need to be able to add more manufacturers to the list of interested manufacturers (might need to add Manufactuer6, 7, 8, etc.).

I would appreciate some help with composing such a macro.

 

[alansidman]

I would do this with a Parameter query in Power Query.

Here is a Mr E tutorial on how to achieve this.

 

[I_know_nuffin]

try the below on a test sheet of your data
add the filter name into the input box
it filters the list and copies out to a new sheet - names the sheet to the filter
it will loop until you enter stop in the input box - Stop is set as the default text

Sub copyloop()

'Test Sheet Name = "Data" :- Change this in the below to the sheet name your working with
'Test range of data used was "$A$1:$F$256" :- change this to cover all your data
' Range("A1:F252").Select :- change to cover your data
'Filter was on Column 3 :- Field:=3 change this to your filter column number


Dim filterstr As String
filterstr = ""
Do While filterstr <> "Stop"
filterstr = InputBox("Enter your filter", "Enter your filter text or Stop to end", "Stop")
If filterstr = "Stop" Then
    Exit Do
Else
    Sheets("Data").Select
   
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$F$256").AutoFilter Field:=3, Criteria1:=filterstr
       
    Range("A1:F252").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = filterstr
    Range("A1").Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("Data").Select
End If

Loop
Selection.AutoFilter
Range("A1").Select
End Sub

 

[johnnyL]

@Deafdog Can you provide a short sample of what the data looks like that you receive? You don't have to provide actual data if it is sensitive data, you can change whatever you don't feel comfortable sharing.

 

[Deafdog]

I appreciate the help so far - I need something easy enough to do that with some instructions somebody else can do this task without downloading/installing anything else...

I know how to take a macro and run it on a spreadsheet so I hope to get something like that (a bunch of text) that does all the "work" without intervention.

I uploaded a sample to my OneDrive:

Sample Data

In the sample let's say I want all the rows (and columns) into a separate sheet or workbook where the Manufacturer column contains LG, NEC, SAMSUNG (and I'll need to add more).
I would hope to keep the original list intact but I suppose...
Another option might be to just delete all the rows where the Manufacturer does not contain LG, NEC, SAMSUNG (and I'll need to add more).

I'll need to add more than those three so it needs to be easy for me to add a few more manufacturers to that list.

 

[I_know_nuffin]

based on your sample data add the below into the thisWorkbook option in the VBAProject and run using F5

adding a button to run this would probably be the best option

Sub copyloop()

'Test Sheet Name = "Data" :- Change this in the below to the sheet name your working with
'Test range of data used was "$A$1:$F$256" :- change this to cover all your data
' Range("A1:F252").Select :- change to cover your data
'Filter was on Column 3 :- Field:=3 change this to your filter column number


Dim filterstr As String, filterstr1 As String
filterstr = ""
Do While filterstr <> "Stop"
filterstr = InputBox("Enter your filter", "Enter your filter text or Stop to end", "Stop")
If filterstr = "Stop" Then
    Exit Do
Else
    Sheets("Data").Select
    
    filterstr1 = "*" & filterstr & "*"
    'Debug.Print filterstr
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$J$256").AutoFilter Field:=1, Criteria1:=filterstr1
       
    Range("A1:J256").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = filterstr
    Range("A1").Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("Data").Select
End If

Loop
Selection.AutoFilter
Range("A1").Select
End Sub

 

[JohnTester]

This is a filter I use with data edited for your use.
it filters Col C and displays only info that match with what you enter.

This code is copied into the sheet you want it to pull to, Not from.

Private Sub Worksheet_Activate()
Dim LR As Long

Me.UsedRange.Offset(2).ClearContents            'clear existing data

With Sheets("Sheet1")                                 'the name must match your source sheet
    .AutoFilterMode = False                         'remove any prior filtering
    .Rows(1).AutoFilter                             'activate autofilter
    .Rows(1).AutoFilter 3, "Manufacturer1"              'filter column C for Manufacturer 1
    LR = .Range("A" & .Rows.Count).End(xlUp).Row    'is any data visible?
    If LR > 1 Then
        .Range("A2:Z" & LR).Copy Range("A2")        'copy any data visible to report
    Else
        Range("A2") = "no data found"               'if none, give that message
    End If
    .AutoFilterMode = False                         'turn off autofilter
End With

End Sub

 

[alansidman]

Here is a link to Box.Net with your file and three parameters. It also contains a Macro to update the file. Instructions are in the file.

SampleData.xlsm | Powered by Box

app.box.com