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

J

jconkl02

Board Regular
Joined
May 25, 2016
Messages
55
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

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

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.
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
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

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


Code: 
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
Click to expand...
 
Upvote 0
jconkl02 said:
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
Click to expand...


Try this

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

Code: 
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
 
Upvote 0
DanteAmor,

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

Jason
DanteAmor said:
Try this

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

Code: 
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
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,903
Messages
6,175,286
Members
452,631
Latest member
a_potato

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