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

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

EngineerNumberQueueRecord TypeSubjectStatus~SeverityAge in Days
-2292TACIncident - Vz oRANCan not update firmware on RRHREJECTEDSeverity 40
Cornelius2996TACIncident - Vz oRANVSWR Alarm at Eastham 2 C57277.RESOLVEDSeverity 4108
Bashful3028TACIncident - Vz oRAN73.894 Time Warner Hub BBU1 alpha not taking trafficREJECTEDSeverity 40
Dopey3039TACIncident - Vz oRAN062041 site RRH[0-5-0] configuration no longer existRESOLVEDSeverity 4106
Bashful3073TACIncident - Vz oRANVLSM does not launchRESOLVEDSeverity 4102
Doc3079TACIncident - Vz oRANALU RRH CELL 22 NO TRAFFICRESOLVEDSeverity 4102
Bashful3105TACIncident - Vz oRANnot processing trafficRECOVEREDSeverity 3100
Snow White3106TACIncident - Vz oRANTest VSWR on Nokia 850 RRHsRESOLVEDSeverity 3100
Cornelius3138TACIncident - Vz oRANRET issue on Converted sitesRESOLVEDSeverity 399
-3201TACIncident - Vz oRAN73.209 Latta Road AWS RRH overpower alarmsPENDING CUSTOMERSeverity 494
Huckepack3348TACIncident - Vz oRANSite not 100% usable in the vLSMRESOLVEDSeverity 486
Doc3433TACIncident - Vz oRAN066167 Alpha AWS DownRESOLVEDSeverity 482
Sneezy3457TACIncident - Vz oRANALPT old data is included in new tar filesPENDING RCASeverity 480
Bashful3486TACIncident - Vz oRAN73235 Bushnell Basin Cell unavailable with context dropPENDING RELEASESeverity 378
Bashful3495TACIncident - Vz oRANCan not take 911 / not visible vSLM Winder MediumRESOLVEDSeverity 477
Purzelbaum3500TACIncident - Vz oRANCPRI oosRESOLVEDSeverity 477
Sleepy3513TACIncident - Vz oRANRRH OVER POWERREJECTEDSeverity 30
-3528TACIncident - Vz oRANAll 850 sectors alarming TX-OUT-OF-ORDERPENDING CUSTOMERSeverity 473
Sneezy3562TACIncident - Vz oRANCan't access LSM GUI from SANERESOLVEDSeverity 471
Bashful3565TACIncident - Vz oRAN70207 and 70308 RRHs with OPARECOVEREDSeverity 471
-3572TACIncident - Vz oRAN070308_SCRANTONRESOLVEDSeverity 470
Pick3574TACIncident - Vz oRANUnstitched CSL spikes on DCM bladesPENDING CUSTOMERSeverity 470
Sleepy3575TACIncident - Vz oRANvLSM inquiryRESOLVEDSeverity 470
Purzelbaum3635TACIncident - Vz oRANcells-oosRESOLVEDSeverity 365
Sleepy3637TACIncident - Vz oRANYorkshire Cell 070212RESOLVEDSeverity 365
Sleepy3658TACIncident - Vz oRAN074080 High RSSI alarm when Power enabled on ALD PortsASSIGNEDSeverity 364
Sneezy3660TACIncident - Vz oRANMultiple sites having RRH DC Input Fail - 42 RRHsASSIGNEDSeverity 464
Sneezy3661TACIncident - Vz oRANMultiple Sites having RRH Over Power Alarm -124 RRHsASSIGNEDSeverity 464

<tbody>
</tbody>
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Try this

Code:
Option Explicit
Sub Create_separate_worksheet()
    Dim c As Range, sh As Worksheet, Ky As Variant
    
    Set sh = Sheets(1)
    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").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
or instead of many sheets just one with the choice of an engineer and data change according to the choice

EngineerEngineerNumberQueueRecord TypeSubjectStatus~SeverityAge in Days
BashfulBashful
3028​
TACIncident - Vz oRAN73.894 Time Warner Hub BBU1 alpha not taking trafficREJECTEDSeverity 4
0​
Bashful
3073​
TACIncident - Vz oRANVLSM does not launchRESOLVEDSeverity 4
102​
Bashful
3105​
TACIncident - Vz oRANnot processing trafficRECOVEREDSeverity 3
100​
Bashful
3486​
TACIncident - Vz oRAN73235 Bushnell Basin Cell unavailable with context dropPENDING RELEASESeverity 3
78​
Bashful
3495​
TACIncident - Vz oRANCan not take 911 / not visible vSLM Winder MediumRESOLVEDSeverity 4
77​
Bashful
3565​
TACIncident - Vz oRAN70207 and 70308 RRHs with OPARECOVEREDSeverity 4
71​
 
Last edited:
Upvote 0
Why not just filter on each Engineer's name to see only that Data. Highlight your top line which displays your categories. Click on Data. Click on Filter. In the Engineer Column, click on the dropdown arrow and select an Engineer.
 
Upvote 0
Thank you DanteAmor. You got me half way to my goal. Your code generates separate worksheets for each engineer and puts a header row at the top of each, but it does not copy the rows associated with each engineer to the appropriate worksheet.

Try this

Code:
Option Explicit
Sub Create_separate_worksheet()
    Dim c As Range, sh As Worksheet, Ky As Variant
    
    Set sh = Sheets(1)
    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").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
alansidman,

This is going to be a report that will go out to a list of engineers with ticket assignments for each to complete. My peer has been doing it manually for about a year and did not know that it could be automated. I know that it can, just not how it is done.

Why not just filter on each Engineer's name to see only that Data. Highlight your top line which displays your categories. Click on Data. Click on Filter. In the Engineer Column, click on the dropdown arrow and select an Engineer.
 
Upvote 0
Thank you DanteAmor. You got me half way to my goal. Your code generates separate worksheets for each engineer and puts a header row at the top of each, but it does not copy the rows associated with each engineer to the appropriate worksheet.

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

See if this works for you.

Code:
Sub Seperate_By_Engineer()
    Dim shArray()
    Dim ws As Worksheet
    ReDim shArray(Sheets"Tickets").UsedRange.Rows.Count, Sheets("Tickets").UsedRange.Columns.Count)
    shArray = Range(Cells(1, 1), Cells(UBound(shArray, 1), UBound(shArray, 2)))
    For i = LBound(shArray, 1) + 1 To UBound(shArray, 1)
        doCreate = True
        For Each sh In ThisWorkbook.Sheets
            If sh.Name = shArray(i, 1) Then
                doCreate = False
                Exit For
            End If
        Next sh
        If doCreate Then
            Set ws = ThisWorkbook.Sheets.Add
            ws.Name = shArray(i, 1)
            For x = LBound(shArray, 1) To UBound(shArray, 1)
                For y = LBound(shArray, 2) To UBound(shArray, 2)
                    If x = LBound(shArray, 1) Then
                        ws.Cells(x, y) = shArray(x, y)
                    Else
                        If shArray(x, 1) = shArray(i, 1) Then
                            If y = 1 Then curRow = ws.UsedRange.Rows.Count + 1
                            ws.Cells(curRow, y) = shArray(x, y)
                        End If
                    End If
                Next y
            Next x
        End If
    Next i
End Sub
 
Last edited:
Upvote 0
Steve_
I'm getting a compile error on the 3rd line:
ReDim shArray(Sheets"Tickets").UsedRange.Rows.Count, Sheets("Tickets").UsedRange.Columns.Count)
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,184
Members
448,554
Latest member
Gleisner2

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