Create a separate worksheet for every unique name in Column A and copy data to each worksheet

[jconkl02]

I need some help. I want to create separate worksheets for each unique name found in Column A of the first worksheet in the workbook. Then I want to copy the entire row of data in the first worksheet to the newly created worksheets.


Using "Doc" as an example. A new worksheet is created named "Doc" and then each row of data that has "Doc" in column A would get copied to the new worksheet named "Doc". I need that for all the names in Column A. There will be some entries that just have a hyphen in Column A. It too needs it's own worksheet. My work laptop isn't allow me to install the MrExcel HTML Maker, so I'm just cutting and pasting it. I know it's not preferred.

The top row is a header starting at A1

Engineer	Number	Queue	Record Type	Subject	Status~	Severity	Age in Days
-	2292	TAC	Incident - Vz oRAN	Can not update firmware on RRH	REJECTED	Severity 4	0
Cornelius	2996	TAC	Incident - Vz oRAN	VSWR Alarm at Eastham 2 C57277.	RESOLVED	Severity 4	108
Bashful	3028	TAC	Incident - Vz oRAN	73.894 Time Warner Hub BBU1 alpha not taking traffic	REJECTED	Severity 4	0
Dopey	3039	TAC	Incident - Vz oRAN	062041 site RRH[0-5-0] configuration no longer exist	RESOLVED	Severity 4	106
Bashful	3073	TAC	Incident - Vz oRAN	VLSM does not launch	RESOLVED	Severity 4	102
Doc	3079	TAC	Incident - Vz oRAN	ALU RRH CELL 22 NO TRAFFIC	RESOLVED	Severity 4	102
Bashful	3105	TAC	Incident - Vz oRAN	not processing traffic	RECOVERED	Severity 3	100
Snow White	3106	TAC	Incident - Vz oRAN	Test VSWR on Nokia 850 RRHs	RESOLVED	Severity 3	100
Cornelius	3138	TAC	Incident - Vz oRAN	RET issue on Converted sites	RESOLVED	Severity 3	99
-	3201	TAC	Incident - Vz oRAN	73.209 Latta Road AWS RRH overpower alarms	PENDING CUSTOMER	Severity 4	94
Huckepack	3348	TAC	Incident - Vz oRAN	Site not 100% usable in the vLSM	RESOLVED	Severity 4	86
Doc	3433	TAC	Incident - Vz oRAN	066167 Alpha AWS Down	RESOLVED	Severity 4	82
Sneezy	3457	TAC	Incident - Vz oRAN	ALPT old data is included in new tar files	PENDING RCA	Severity 4	80
Bashful	3486	TAC	Incident - Vz oRAN	73235 Bushnell Basin Cell unavailable with context drop	PENDING RELEASE	Severity 3	78
Bashful	3495	TAC	Incident - Vz oRAN	Can not take 911 / not visible vSLM Winder Medium	RESOLVED	Severity 4	77
Purzelbaum	3500	TAC	Incident - Vz oRAN	CPRI oos	RESOLVED	Severity 4	77
Sleepy	3513	TAC	Incident - Vz oRAN	RRH OVER POWER	REJECTED	Severity 3	0
-	3528	TAC	Incident - Vz oRAN	All 850 sectors alarming TX-OUT-OF-ORDER	PENDING CUSTOMER	Severity 4	73
Sneezy	3562	TAC	Incident - Vz oRAN	Can't access LSM GUI from SANE	RESOLVED	Severity 4	71
Bashful	3565	TAC	Incident - Vz oRAN	70207 and 70308 RRHs with OPA	RECOVERED	Severity 4	71
-	3572	TAC	Incident - Vz oRAN	070308_SCRANTON	RESOLVED	Severity 4	70
Pick	3574	TAC	Incident - Vz oRAN	Unstitched CSL spikes on DCM blades	PENDING CUSTOMER	Severity 4	70
Sleepy	3575	TAC	Incident - Vz oRAN	vLSM inquiry	RESOLVED	Severity 4	70
Purzelbaum	3635	TAC	Incident - Vz oRAN	cells-oos	RESOLVED	Severity 3	65
Sleepy	3637	TAC	Incident - Vz oRAN	Yorkshire Cell 070212	RESOLVED	Severity 3	65
Sleepy	3658	TAC	Incident - Vz oRAN	074080 High RSSI alarm when Power enabled on ALD Ports	ASSIGNED	Severity 3	64
Sneezy	3660	TAC	Incident - Vz oRAN	Multiple sites having RRH DC Input Fail - 42 RRHs	ASSIGNED	Severity 4	64
Sneezy	3661	TAC	Incident - Vz oRAN	Multiple Sites having RRH Over Power Alarm -124 RRHs	ASSIGNED	Severity 4	64

<tbody>
</tbody>

 

[Steve_]

Steve_
I'm getting a compile error on the 3rd line:
ReDim shArray(Sheets"Tickets").UsedRange.Rows.Count, Sheets("Tickets").UsedRange.Columns.Count)

That should have been..

ReDim shArray(Sheets("Tickets").UsedRange.Rows.Count, Sheets("Tickets").UsedRange.Columns.Count)[/QUOTE]


And "Tickets" should be whatever your sheet name with the master data on it is.

 

[DanteAmor]

DanteAmor,
Disregard my earlier reply where I said that it only made the worksheets, but didn't copy the data. I made a mistake. Your macro works like a champ. Thank you.

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

 

[jconkl02]

The problem is that I ran it with two other Sheets in front of my main worksheet. When I do that it only creates the unique worksheets, but does not populate them. When I remove the other two sheet first your code works perfect. I did not think about that when I made my request. Can your code be easily modified to start adding worksheets after the 3rd existing worksheet? Those worksheets are named Report, Names and LastComment.

Thanks
Jason

The macro works for me. Maybe there are spaces in column A, or something weird is in your data.
Try this:

Sub Create_separate_worksheet()
    Dim c As Range, sh As Worksheet, Ky As Variant
    
    Set sh = Sheets(1)
    If sh.AutoFilterMode Then sh.AutoFilterMode = False
    With CreateObject("scripting.dictionary")
        For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(xlUp))
            If c.Value <> "" Then .Item(c.Value) = Empty
        Next c
        For Each Ky In .Keys
            sh.Range("A1:H" & sh.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter 1, Ky
            Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
            sh.AutoFilter.Range.EntireRow.Copy Range("A1")
        Next Ky
    End With
    sh.ShowAllData
End Sub

 

[DanteAmor]

The problem is that I ran it with two other Sheets in front of my main worksheet. When I do that it only creates the unique worksheets, but does not populate them. When I remove the other two sheet first your code works perfect. I did not think about that when I made my request. Can your code be easily modified to start adding worksheets after the 3rd existing worksheet? Those worksheets are named Report, Names and LastComment.

Thanks
Jason

Try this

change in the code "Main Sheet" for the name of your main sheet

Sub Create_separate_worksheet()
    Dim c As Range, sh As Worksheet, Ky As Variant
    
    Set sh = Sheets("[COLOR=#ff0000]Main Sheet[/COLOR]")
    If sh.AutoFilterMode Then sh.AutoFilterMode = False
    With CreateObject("scripting.dictionary")
        For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(xlUp))
            If c.Value <> "" Then .Item(c.Value) = Empty
        Next c
        For Each Ky In .Keys
            sh.Range("A1:H" & sh.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter 1, Ky
            Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
            sh.AutoFilter.Range.EntireRow.Copy Range("A1")
        Next Ky
    End With
    sh.ShowAllData
End Sub

 

[jconkl02]

DanteAmor,

That did the trick! Thank you very much for the help.

Jason

Try this

change in the code "Main Sheet" for the name of your main sheet

Sub Create_separate_worksheet()
    Dim c As Range, sh As Worksheet, Ky As Variant
    
    Set sh = Sheets("[COLOR=#ff0000]Main Sheet[/COLOR]")
    If sh.AutoFilterMode Then sh.AutoFilterMode = False
    With CreateObject("scripting.dictionary")
        For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(xlUp))
            If c.Value <> "" Then .Item(c.Value) = Empty
        Next c
        For Each Ky In .Keys
            sh.Range("A1:H" & sh.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter 1, Ky
            Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
            sh.AutoFilter.Range.EntireRow.Copy Range("A1")
        Next Ky
    End With
    sh.ShowAllData
End Sub

 

[DanteAmor]

DanteAmor,

That did the trick! Thank you very much for the help.

Jason

Again with pleasure. Thanks for the feedback