Create new Excel Worksheets named with the unique values (and the # of rows) from a column & copy the rows to the proper worksheet.

Need to create new tabs in excel based on column (B in this example)
The pictures should be fairly self-explanatory.
Thank you for your time in advance!
First image is current excel workbook
Second image is desired future state
I also attached the Excel file.
EE.pngee3.pngEE2.png
Sample-EE.xlsx
LVL 9
K BAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rodney EndrigaData AnalystCommented:
Hi K B, let me know if this works for you:

Sub EE_CreateSheetsfromCells()
Dim nm As Long, src As Worksheet, shtName1 As String, shtName2 As String, cnt As Long, wbk As Workbook, sht As Worksheet

Set src = ActiveSheet
Set wbk = ActiveWorkbook

For nm = 1 To src.UsedRange.Rows.Count
    If Trim(Cells(nm, 2).Value) <> "" Then
        If Len(Cells(nm, 2).Value) > 31 Then
            shtName1 = Left(Trim(Cells(nm, 2).Value), 31)
        Else
            shtName1 = Trim(Cells(nm, 2).Value)      ' NAMES are all in Column B only
        End If
        If Len(Cells(nm + 1, 2).Value) > 31 Then
            shtName2 = Left(Trim(Cells(nm + 1, 2).Value), 31)
        Else
            shtName2 = Trim(Cells(nm + 1, 2).Value)    ' Compares NAMES in Column B only
        End If
        If shtName1 <> shtName2 Then
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = shtName1
            src.Select
        End If
    End If
Next nm

For nm = 1 To src.UsedRange.Rows.Count
    Cells(nm, 2).EntireRow.Copy
    Sheets(Cells(nm, 2).Value).Select
    If IsEmpty(Cells(1, 1).End(xlUp).Value) = True Then
        Cells(1, 1).End(xlUp).Select
    Else
        Cells(ActiveSheet.UsedRange.Rows.Count, 1).Offset(1, 0).Select
    End If
    ActiveSheet.Paste
    Application.CutCopyMode = False
    src.Select
Next nm

For Each sht In wbk.Worksheets
    If sht.Name <> "Sheet1" Then
        sht.Select
        ActiveSheet.Name = sht.Name & "-" & sht.UsedRange.Rows.Count
        Cells(1, 1).Select
    End If
Next sht
End Sub

This will create new worksheets based off unique names. It will then add each row related to each sheet, as needed.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
K BAuthor Commented:
thank you!
Does it also name the tabs with the unique names + number of rows?
0
Rodney EndrigaData AnalystCommented:
Yes it does. Try out the code and see if the results is what you requested.
0
CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

K BAuthor Commented:
Okay thank you Rodney.

It has been running for about 10 minutes so far.  It looks like it is analyzing the rows (perhaps more specifically column B) as it has yet to make a single tab.  The spreadsheet has 29,000 rows.  I might need to stop it and take a look in 15 minutes when I get home.

Again thank you for this!

K.B.
0
Rodney EndrigaData AnalystCommented:
No problem K.B.

You can also put these additions to the code:

Sub EE_CreateSheetsfromCells()
Application.ScreenUpdating=False

......{leave existing code here}......

Application.ScreenUpdating=True
End Sub

It may speed up the process.
0
K BAuthor Commented:
Thank you .  
Sorry for the delay.. I just kicked it off with your amended code about 10 minutes ago.  I will let you know when it completes.
0
K BAuthor Commented:
it returned an error that i typed an invalid name for a worksheet. when i clicked Debug... it highlighted this line:
 ActiveSheet.Name = sht.Name & "-" & sht.UsedRange.Rows.Count

It also filled my clipboard full on entire rows ... which is no big deal but maybe it offers insight somehow.

It created all the necessary tabs - named correctly... but it did not include the row count along with the name.
All tabs had one row of correct data - the rest of the rows were blank.

Pretty close I imagine.
Thank you again for your efforts.  I really do appreciate it.

K.B.
0
Rodney EndrigaData AnalystCommented:
Hi K.B.,

I adjusted to code in this attached file. Let me know if this works better for you.

I tested the code out on 25,000 rows of data and it processed in under 5 minutes.

This shortcut opens the Visual Basic Editor (ALT + F11 key). The VBA code is in 'ThisWorkbook' (Microsoft Excel Objects).
Sample-EE.xlsb
0
K BAuthor Commented:
It seems I am having the same issue ..

Does it matter that there is no data in column A from the source sheet?
I have data in column B through column J

The results were fairly similar...
Only one row of data appears on each newly created tab.

Each tab is named the correct name & the number "1".
So, Apples-1, Oranges-1 etc...
0
Rodney EndrigaData AnalystCommented:
I ran the code on the Sample data and it worked successfully.

The macro is working off the data in Column B (creating new worksheets & transferring data to those new worksheets).

If there is no data in Column A, it does make a difference. You will have to adjust 1-line of code:

If IsEmpty(Cells(Rows.Count, 1).End(xlUp).Value) = True Then

TO this line

If IsEmpty(Cells(Rows.Count, 2).End(xlUp).Value) = True Then

Basically, changing the number '1' to a '2'. When you update the line, it should work better for you.

I updated the code in this attached file.
Sample-EE.xlsb
0
K BAuthor Commented:
Worked perfect!  thank you for your patience!
0
Rodney EndrigaData AnalystCommented:
Glad to assist, K B! Happy coding...
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.