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)

Init

Number

Station

ST

Track/ Sequence

Train ID

Division

Origin Station

Or ST

Shipper

Destination Station

Ds ST

Consignee

ADMX

15599

BARSTOW

CA

1508- 34

CALIFORNIA

MARSHALL

MN

ADMCORPROCES

COLTON

CA

ARCHERDANMID

BNSF

518052

KAISER

CA

2126- 1

CALIFORNIA

FONTANA

CA

ADVANCSTEREC

ARMOREL

AR

NUCORYSTEEL

MWCX

204154

KAISER

CA

2126- 2

CALIFORNIA

FONTANA

CA

ADVANCSTEREC

BEAUMONT

TX

OPTIMUSTELLC

GRW

4391

PITTSBURG

CA

0699-107

CALIFORNIA

STLOUIS

MO

AGENT

MADISON

IL

DELIVESWITCH

GACX

55610

SPRINGFIE

MO

0111- 18

HEARTLAND

KANCITY

KS

AGPROINCACOO

MONETT

MO

TYSONFOODS

TILX

54864

AMASYARD

TX

0104- 11

KANSAS

DAWSON

MN

AGPROINCACOO

DALHART

TX

CARGILL

TILX

55193

AMASYARD

TX

0104- 12

KANSAS

DAWSON

MN

AGPROINCACOO

DALHART

TX

CARGILL

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

 

[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.