Create new worksheet for each vendor

I

i8ur4re

Board Regular
Joined
Mar 1, 2015
Messages
97
Hi,

I have an excel sheet that has about 5000+ Sku's from over 150+ vendors, my excel sheet has a vendor column ( C ), I am going throught this manually which has taken me days to copy paste each vendor in a worksheet.

I am 5 hours in and realized i did about 50%, anyway i can automate this with a code or formula?

Thank you
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Sort by date Sort by votes
How about
Code: 
Sub i8ur4re()
   Dim Cl As Range
   Dim Ws As Worksheet
   Dim Ky As Variant
   
   Set Ws = ActiveSheet
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("C2", Ws.Range("C" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Empty
      Next Cl
      For Each Ky In .keys
         Ws.Range("A1:Z1").AutoFilter 3, Ky
         Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
         Ws.AutoFilter.Range.Copy Range("A1")
      Next Ky
      Ws.AutoFilterMode = False
   End With
End Sub
 
Upvote 0
Fluff said:
How about
Code: 
Sub i8ur4re()
   Dim Cl As Range
   Dim Ws As Worksheet
   Dim Ky As Variant
   
   Set Ws = ActiveSheet
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("C2", Ws.Range("C" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Empty
      Next Cl
      For Each Ky In .keys
         Ws.Range("A1:Z1").AutoFilter 3, Ky
         Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
         Ws.AutoFilter.Range.Copy Range("A1")
      Next Ky
      Ws.AutoFilterMode = False
   End With
End Sub
Click to expand...

I got a run-time error 1004:
Application-define or oobject-defined error.
 
Upvote 0
i8ur4re said:
I got a run-time error 1004:
Application-define or oobject-defined error.
Click to expand...

I fixed that error, but i did get a Run-Time error 1004

You typed an invalid name for a sheet or chart. Make sure that:
The name that you type does not exceed 31 characters.
The name does not contain any of the following characters: \ / ?* [ or ]
You did not leave the name blank.

I did notice some vendor names might surpass the 31 characters, anyway around this, maybe trim at 30 characters?

This line gave the error:

Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
 
Last edited:
Upvote 0
You could use
Code: 
Sheets.Add(, Sheets(Sheets.Count)).Name = Left(Ky,30)
as long as the vendor names don't contain any illegal characters.
 
Upvote 0
Fluff said:
You could use
Code: 
Sheets.Add(, Sheets(Sheets.Count)).Name = Left(Ky,30)
as long as the vendor names don't contain any illegal characters.
Click to expand...

That worked, the last problem im facing is it creates the new worksheets but they are empty, any chance i can take all the content for that vendor and move it to the new worksheet? Its currently only taking the header.
 
Upvote 0
Do you have any blank rows in the data?
 
Upvote 0
Fluff said:
Do you have any blank rows in the data?
Click to expand...

Yes, I do have a few empty rows or missing data, here is what 2 rows look like, this is the original, i managed to clean it up prior, but at this rate, i can go with the information below:

[TABLE="width: 4367"]
<colgroup><col><col span="4"><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col span="2"><col><col><col><col span="3"></colgroup><tbody>[TR]
[TD]Sku[/TD]
[TD]Dim.1[/TD]
[TD]Dim.2[/TD]
[TD]Dim.3[/TD]
[TD]Dim.4[/TD]
[TD]Store[/TD]
[TD]Description[/TD]
[TD]Vendor[/TD]
[TD]Department[/TD]
[TD]Product Number[/TD]
[TD]QTYAVL[/TD]
[TD]QOH[/TD]
[TD]SOLD[/TD]
[TD]COMIT[/TD]
[TD]QOO[/TD]
[TD]SO[/TD]
[TD]QTBP[/TD]
[TD]RECV[/TD]
[TD]TRAN[/TD]
[TD]OT[/TD]
[TD]IT[/TD]
[TD]ADJ[/TD]
[TD]Min[/TD]
[TD]Max[/TD]
[TD]QROP[/TD]
[TD]Lookups[/TD]
[TD]Dim.1 Group[/TD]
[TD]Dim.1 Description[/TD]
[TD]Dim.2 Group[/TD]
[TD]Dim.2 Description[/TD]
[TD]Dim.3 Group[/TD]
[TD]Dim.3 Description[/TD]
[TD]Dim.4 Group[/TD]
[TD]Dim.4 Description[/TD]
[TD]In Store Location[/TD]
[TD]Price[/TD]
[TD]ListCost[/TD]
[TD]AvgCost[/TD]
[TD]Brand[/TD]
[TD]Season[/TD]
[TD]Bin Picking#[/TD]
[TD]Tax1[/TD]
[TD]Tax2[/TD]
[TD]Tax3[/TD]
[/TR]
[TR]
[TD="align: right"]8024[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]True Terpenes .5ml Ceramic Cartridge White[/TD]
[TD]True Terpenes[/TD]
[TD]Extraction[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]19192[/TD]
[TD="align: right"]4830[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]25000[/TD]
[TD="align: right"]-1100[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]122[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$0.99[/TD]
[TD="align: right"]$0.80[/TD]
[TD="align: right"]$0.80[/TD]
[TD]True Terpenes[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6258[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Cartridge Plastic Containers .5 ml ::$0.25[/TD]
[TD]Ypsilanti Oil Company[/TD]
[TD]Extraction[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]17042[/TD]
[TD="align: right"]31327[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]54000[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]-5631[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$0.25[/TD]
[TD="align: right"]$0.12[/TD]
[TD="align: right"]$0.11[/TD]
[TD]$$$[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Ok how about
Code: 
Sub i8ur4re()
   Dim Cl As Range
   Dim Ws As Worksheet
   Dim Ky As Variant
   Dim UsdRws As Long
   
   Set Ws = ActiveSheet
   UsdRws = Ws.Range("C" & Rows.Count).End(xlUp).Row
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("C2:C" & UsdRws)
         .Item(Cl.Value) = Empty
      Next Cl
      For Each Ky In .keys
         Ws.Range("A1:Z" & UsdRws).AutoFilter 3, Ky
         Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
         Ws.AutoFilter.Range.Copy Range("A1")
      Next Ky
      Ws.AutoFilterMode = False
   End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
How can I sort rows into different worksheets?
Replies
2
Views
117
nithchun
N
M
  • Solved
Repeatedly finding the sum of values in a dataset between two endpoints
Replies
2
Views
230
mr_steveb
M
Data123
  • Question Question
Excel 365 Stock End Of Day Data Providers
Replies
5
Views
589
Data123
Data123
D
  • Question Question
Total hours minus 30 minutes
Replies
1
Views
347
Kaper
Kaper
R
  • Question Question
Time sheet formulas
Replies
2
Views
312
rodnaaaaay
R

Forum statistics

Threads
1,223,885
Messages
6,175,183
Members
452,615
Latest member
bogeys2birdies

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top