VBA solution to create worksheets based on cell value and then copy data to its new worksheet

[sachavez]

Hello,

I'm looking for some code that will:

1. Evaluate my data set in my "test" worksheet. The header for my data set begins in worksheet("Test"), cell A3, and the size of the data set varies weekly.
2. Create new worksheets (and name the new worksheet) based on the cell content is the "Test" worksheet, to newly created worksheets, range("J4") to the end of column J.
3. Copy the data from my test worksheet to the newly created worksheets.

Thanks in advance.

Steve

 

[sachavez]

The shipper column is column J.

You can see that there are two transactions for shipper (OR CUSTOMER) ADVANCSTEREC, so I would want all of their transactions in the same work sheet. The rows end in column Q (I left off a few columns, below)


[TABLE="width: 1683"]
<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Init[/TD]
[TD]Number[/TD]
[TD]Station[/TD]
[TD]ST[/TD]
[TD]Track/
Sequence[/TD]
[TD]Train ID[/TD]
[TD]Division[/TD]
[TD]Origin
Station[/TD]
[TD]Or
ST[/TD]
[TD]Shipper[/TD]
[TD]Destination
Station[/TD]
[TD]Ds
ST[/TD]
[TD]Consignee[/TD]
[/TR]
[TR]
[TD]ADMX[/TD]
[TD]15599[/TD]
[TD]BARSTOW[/TD]
[TD]CA[/TD]
[TD]1508- 34[/TD]
[TD] [/TD]
[TD]CALIFORNIA[/TD]
[TD]MARSHALL[/TD]
[TD]MN[/TD]
[TD]ADMCORPROCES[/TD]
[TD]COLTON[/TD]
[TD]CA[/TD]
[TD]ARCHERDANMID[/TD]
[/TR]
[TR]
[TD]BNSF[/TD]
[TD]518052[/TD]
[TD]KAISER[/TD]
[TD]CA[/TD]
[TD]2126- 1[/TD]
[TD] [/TD]
[TD]CALIFORNIA[/TD]
[TD]FONTANA[/TD]
[TD]CA[/TD]
[TD]ADVANCSTEREC[/TD]
[TD]ARMOREL[/TD]
[TD]AR[/TD]
[TD]NUCORYSTEEL[/TD]
[/TR]
[TR]
[TD]MWCX[/TD]
[TD]204154[/TD]
[TD]KAISER[/TD]
[TD]CA[/TD]
[TD]2126- 2[/TD]
[TD] [/TD]
[TD]CALIFORNIA[/TD]
[TD]FONTANA[/TD]
[TD]CA[/TD]
[TD]ADVANCSTEREC[/TD]
[TD]BEAUMONT[/TD]
[TD]TX[/TD]
[TD]OPTIMUSTELLC[/TD]
[/TR]
[TR]
[TD]GRW[/TD]
[TD]4391[/TD]
[TD]PITTSBURG[/TD]
[TD]CA[/TD]
[TD]0699-107[/TD]
[TD] [/TD]
[TD]CALIFORNIA[/TD]
[TD]STLOUIS[/TD]
[TD]MO[/TD]
[TD]AGENT[/TD]
[TD]MADISON[/TD]
[TD]IL[/TD]
[TD]DELIVESWITCH[/TD]
[/TR]
[TR]
[TD]GACX[/TD]
[TD]55610[/TD]
[TD]SPRINGFIE[/TD]
[TD]MO[/TD]
[TD]0111- 18[/TD]
[TD] [/TD]
[TD]HEARTLAND[/TD]
[TD]KANCITY[/TD]
[TD]KS[/TD]
[TD]AGPROINCACOO[/TD]
[TD]MONETT[/TD]
[TD]MO[/TD]
[TD]TYSONFOODS[/TD]
[/TR]
[TR]
[TD]TILX[/TD]
[TD]54864[/TD]
[TD]AMASYARD[/TD]
[TD]TX[/TD]
[TD]0104- 11[/TD]
[TD] [/TD]
[TD]KANSAS[/TD]
[TD]DAWSON[/TD]
[TD]MN[/TD]
[TD]AGPROINCACOO[/TD]
[TD]DALHART[/TD]
[TD]TX[/TD]
[TD]CARGILL[/TD]
[/TR]
[TR]
[TD]TILX[/TD]
[TD]55193[/TD]
[TD]AMASYARD[/TD]
[TD]TX[/TD]
[TD]0104- 12[/TD]
[TD] [/TD]
[TD]KANSAS[/TD]
[TD]DAWSON[/TD]
[TD]MN[/TD]
[TD]AGPROINCACOO[/TD]
[TD]DALHART[/TD]
[TD]TX[/TD]
[TD]CARGILL[/TD]
[/TR]
</tbody>[/TABLE]

 

[DanteAmor]

Considering the following:
- Name Sheet: "test".
- headings: row 3.
- start of data row 4.
- Important: customer sheets do not exist.

Try:

Sub create_worksheets()
  Dim c As Range, sh As Worksheet, ky As Variant
  Set sh = Sheets("test")
  With CreateObject("scripting.dictionary")
     For Each c In sh.Range("J4", sh.Range("J" & Rows.Count).End(xlUp))
        If c.Value <> "" Then .Item(c.Value) = Empty
     Next c
     For Each ky In .Keys
        sh.Range("A3").AutoFilter Columns("J").Column, ky
        Sheets.Add(, Sheets(Sheets.Count)).Name = ky
        sh.AutoFilter.Range.EntireRow.Copy Range("A3")
     Next ky
  End With
  sh.Select
  sh.ShowAllData
End Sub

 

[sachavez]

Looks like this is going to work. Really appreciate your assistance!!!

 

[DanteAmor]

Ok, try and tell me.

 

[sachavez]

Ok, try and tell me.

It works! Thank you very much!!!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.