• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 204
  • Last Modified:

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
0
K B
Asked:
K B
  • 6
  • 6
1 Solution
 
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
 
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
Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

 
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 6
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now