VBA help required

[Jonathan Jones]

Hi,

I've got a spreadsheet of product data. The data is product part number, description, supplier name and various other product attributes such as lead time, cost, supplier contact and email address, etc.

There's some gaps in the data, e.g. I don't have lead time for all products. I would like to send the list of products to each supplier for them to complete the missing information. Obviously I only want each supplier to see the products which they supply.

The data isn't very clean so I don't want to do this all as one process. Ideally, I'd like some code which creates a new excel file called the supplier name which contains all the products from that supplier, I can then check the data and email the supplier requesting the information.

Any help would be much appreciated - Thanks.

Jonathan

 

[Fluff]

A couple of questions.
1) what column contains the supplier name?
2) do you have a header row in row 1 with data starting in row 2, if not where is your data?

 

[Jonathan Jones]

A couple of questions.
1) what column contains the supplier name?
2) do you have a header row in row 1 with data starting in row 2, if not where is your data?

thanks for replying so quickly.

1) column a contains the supplier name
2) yes, header row in row 1, data starts in row 2

Jonathan

 

[Fluff]

In that case try this

Sub FltrPasteNewWbk()

   Dim Cl As Range
   Dim UsdRws As Long
   Dim OSht As Worksheet
   Dim Wbk As Workbook
   Dim Pth As String
   
Application.ScreenUpdating = False
   
   Pth = ActiveWorkbook.path
   Set OSht = Sheets("Records")
   If OSht.AutoFilterMode Then OSht.AutoFilterMode = False
   UsdRws = OSht.Range("A" & Rows.Count).End(xlUp).Row

   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2:A" & UsdRws)
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Nothing
            OSht.Range("A1").AutoFilter Field:=1, Criteria1:=Cl.Value
            Set Wbk = Workbooks.Add(1)
            OSht.Range("A1:A" & UsdRws).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
               Wbk.Sheets(1).Range("A1")
            Wbk.SaveAs Pth & "\" & Cl.Value, 52
            Wbk.Close
         End If
      Next Cl
   End With
   OSht.Range("A1").AutoFilter

End Sub

It will save the new workbooks in the same folder as the active workbook, but that can be changed if needed.

 

[Jonathan Jones]

Hi,

Thanks for the code. However, it didn't seem to like this line:

Set OSht = Sheets("Records")

 

[Fluff]

Change the sheet name to the name of your sheet.

 

[Jonathan Jones]

Change the sheet name to the name of your sheet.

Sorry - I should have mentioned you are dealing with a complete dimwit - thanks for your help!

Jonathan

 

[Fluff]

Glad to help

 

[Jonathan Jones]

Hi,

Thanks for your help - this worked perfectly. I now have another request for help please.

I now have a folder of excel sheets containing the product information which are named as each supplier e.g. NIKE. I also have another excel spreadsheet which has the name of each supplier in column A and the email address of that supplier in column B. I would like to send each supplier their excel spreadsheet of product information for them to complete.

Obviously, I could attach each to an email one by one but I was hoping it was possible to achieve this with code. My default email client is Outlook 2016. Any help would be very much appreciated.

 

[Fluff]

As this is a completely different question, could you please start a new thread?
Thanks