VBA, dividing an xlsx into multiple sheets

Question

I don't work with VBA very often so I need some help. .xlsx with column headers in row 1. First sheet to work on is named "Submitted" Column I is "Annuity" and what I'm looking for. Under this column will be names. The number of names and rows changes constantly. (issues: some cells could have more than one name divided with a "," and a name will be listed in more than once cell) exp:

I2 = "John Doe"

I3 is "John Doe"

I4 is "John Doe, Jane Doe" (if this happens we only want the first complete name, stopping at the ","

I5 is "Jane Doe" and so on.

What needs to happen is each ROW needs to be cut and pasted onto a new sheet, titled by the name in "Column I_Submitted", with the same column headers and combining all the John Doe's on one sheet, and the Jane Doe's on a separate sheet.

Once this sheet is cleared out, the next sheet is "Paid", do the same thing as with "Submitted" Last is the Sheet "YTD" on this one we want to read column "D" doing the exact same process as the other two sheets.

Thank you for your help.

yep, opened the editor and tried an successfully created a loop to read the names, but as you can see from my posts here, I don't deal with VBA hardly at all. I even went back to my past question as I thought I could come up with some of what I need from there, but the frustrating part for people like me who get help is most of the time the "Smart" people who help don't have time to tell you why they do the things they do, so it's near impossible to learn, since some of us only use VBA 1 or 2 times a year. thank you for expressing your frustration. — tiahuana

JNevill JNevill · Accepted Answer · 2017-05-19T18:26:30

This would be daunting for a VBA newbie, no doubt. There are a lot of little pieces here that can be difficult to figure out, like looping through each row, creating a new worksheet, figuring out which row in the worksheet you are copying to is the last one, figuring how to get the first name from a comma delimited list, etc..

The code below should do pretty much exactly what you need. I've made a ton of comments before each line to explain what it's doing. It should give you a solid jumping off point.

Sub splitUpRows()

    'set up a variable to hold the worksheet from which we will be reading each row
    Dim ws_read As Worksheet
    Set ws_read = ThisWorkbook.Sheets("Submitted")

    'set up a variable to hold the worksheet to which we will write the data
    Dim ws_write As Worksheet

    'A variable to hold whether the ws_write sheet already exists
    Dim ws_write_exists As Boolean

    'A variable to hold which row we are reading, and one to hold which row we are writing
    Dim readRow As Integer, writeRow As Integer

    'A variable to hold the name of the person we are processing
    Dim str_name As String

    'Now loop from row 2 to the last row in the ws_read worksheet
    For readRow = 2 To ws_read.Range("A50000").End(xlUp).Row

        'get the name of the person (or if there are two, get the first one)
        'There are few ways to get the firstname, but here I am "Splitting"
        '  the value in Column I for this row to an array. I am then requesting
        '  the 1st item "(0)" from that array.
        'This is a nice way of doing it because you could quickly 
        '  change this to a for loop for each item in the array
        '  in case you wanted a row for each person from the same line.
        str_name = Split(ws_read.Cells(readRow, 9).Value, ",")(0)

        'Check to see if this sheet already exists by looping through all
        'of the worksheets in this workbook.
        'If it does, then set the ws_write_exists to true and exit the loop
        ws_write_exists = False
        For Each ws_write In ThisWorkbook.Worksheets
            If ws_write.Name = str_name Then ws_write_exists = True: Exit For
        Next ws_write

        'If it doesn't exist, then make it.
        'If it does exist, then it's already set to the right worksheet so
        'no worries just move along.
        If Not ws_write_exists Then

            'Add a new worksheet
            Set ws_write = ThisWorkbook.Worksheets.Add

            'name it after the person
            ws_write.Name = str_name

            'And copy the header row from ws_read to the first row of ws_write
            ws_write.Rows(1).Value2 = ws_read.Rows(1).Value2
        End If

        'So now we definitely have a worksheet for this person
        'And we definitely have ws_write set to that worksheet
        'Lets figure out what row we are writing to
        writeRow = ws_write.Range("A50000").End(xlUp).Row + 1

        'And now lets copy from ws_read to ws_write
        ws_write.Rows(writeRow).Value2 = ws_read.Rows(readRow).Value2
    Next readRow


End Sub

To do this with your "Paid" sheet just change that ws_read to point to "paid". For your "YTD" sheet you'll have to change ws_read AND change the str_name to point to column 4 instead of column 9.

VBA, dividing an xlsx into multiple sheets

1 Answers