Split Excel Rows

I am trying to split an excel spreadsheet via a macro.  The data I have is as follows in the attached document.  On the original tab it shows the data and multiple cells of it on one row.  Then in the final spreadsheet it shows the final output I am trying to achieve.  I want to take the additional data points and copy the delivery persons main information and copy it also.

I am unsure the best way to accomplish this process.  I have tried offset and other methods and just can't seem to pull this off.  Any help would be great.

Thanks.
test.xlsx
gwlanksAsked:
Who is Participating?
 
KimputerConnect With a Mentor Commented:
Here ya go. In case you ever need to change it, because of another column change, just change the first fixedcols and steps assignment:

Sub test()


Dim currentws As Worksheet
Dim newws As Worksheet

Set currentws = ActiveSheet
Set newws = Worksheets.Add(After:=Worksheets(1))
newws.Name = "Final"

colscount = currentws.UsedRange.Columns.Count
rowscount = currentws.UsedRange.Rows.Count

fixedcols = 10
steps = 6
'header

For i = 1 To (fixedcols + steps)
    newws.Cells(1, i) = currentws.Cells(1, i)
Next

'loop rows

deltarows = 0
For i = 2 To rowscount

    'loop cols
    deltacols = 0
    
    For j = fixedcols To colscount Step steps
        'loop per 5 cols
        If Not IsEmpty(currentws.Cells(i, j + 1).Value) Then
            'first rows
            For k = 1 To fixedcols
                newws.Cells(i + deltarows, k) = currentws.Cells(i, k)
            Next
            For k = 1 To steps
                newws.Cells(i + deltarows, k + fixedcols) = currentws.Cells(i, j + k)
                deltacols = deltacols + 1
            Next
            deltarows = deltarows + 1
        End If
        
    Next
    deltarows = deltarows - 1
Next

End Sub

Open in new window

0
 
KimputerCommented:
So column AH will ALWAYS be the last column?
0
 
gwlanksAuthor Commented:
No it could grow each month possibly.  The most I have seen the data grow for the month is to column CC I believe a few times.
0
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
KimputerCommented:
This should be your code:

Sub test()


Dim currentws As Worksheet
Dim newws As Worksheet

Set currentws = ActiveSheet
Set newws = Worksheets.Add(After:=Worksheets(1))
newws.Name = "Final"

colscount = currentws.UsedRange.Columns.Count
rowscount = currentws.UsedRange.Rows.Count


'header

For i = 1 To 14
    newws.Cells(1, i) = currentws.Cells(1, i)
Next

'loop rows

For i = 2 To rowscount

    'loop cols
    For j = 8 To colscount
        'loop per 5 cols
        If Not (currentws.Cells(i, j).Value = "") Then
            'first rows
            For k = 1 To 9
                newws.Cells(i, k) = currentws.Cells(i, k)
            Next
            For k = 1 To 5
                newws.Cells(i, k + j) = currentws.Cells(i, k + j)
            Next
        End If
    
    Next

Next

End Sub

Open in new window


Not too many error checking though, it depends on your source file being "correct" (as in, correct pieces of 5 data parts)
0
 
gwlanksAuthor Commented:
I get the error message of variable not defined and highlights each time colscount =

Should this have to be defined?
0
 
gwlanksAuthor Commented:
Ok I tested again and got it to work.  But here is what is taking place.  It copies everything and doesn't take the data from column Q and create a new line and copy columns A through J into the new line and eliminate the data.  

So it should create a new row and copy column A through J and add the next 5 columns to the right each time it sees 5 new columns of data.  As soon as it is null in the 5 columns to the right of P then done with the loop and move to the next line.  Am I doing something wrong?
0
 
KimputerCommented:
Don't know what happened during testing, I must have been dreaming my outcome was exactly the same as yours.

Here it goes again:

Sub test()


Dim currentws As Worksheet
Dim newws As Worksheet

Set currentws = ActiveSheet
Set newws = Worksheets.Add(After:=Worksheets(1))
newws.Name = "Final"

colscount = currentws.UsedRange.Columns.Count
rowscount = currentws.UsedRange.Rows.Count


'header

For i = 1 To 14
    newws.Cells(1, i) = currentws.Cells(1, i)
Next

'loop rows

deltarows = 0
For i = 2 To rowscount

    'loop cols
    deltacols = 0
    
    For j = 9 To colscount Step 5
        'loop per 5 cols
        If Not IsEmpty(currentws.Cells(i, j + 1).Value) Then
            'first rows
            For k = 1 To 9
                newws.Cells(i + deltarows, k) = currentws.Cells(i, k)
            Next
            For k = 1 To 5
                newws.Cells(i + deltarows, k + 9) = currentws.Cells(i, j + k)
                deltacols = deltacols + 1
            Next
            deltarows = deltarows + 1
        End If
        
    Next
    deltarows = deltarows - 1
Next

End Sub

Open in new window

0
 
gwlanksAuthor Commented:
It is really really close.  It is cutting off 2 columns too soon.  So row 2 of the record is off and it is not copying column J.  

The main record cuts off at Column N not column P.  What do I need to look at to tweak that?
0
 
gwlanksAuthor Commented:
Dis regard my last post momentarily.  I just ran it against the test file and it is fine.  It is when I bring in my real data I have the issue.  Let me try something again and I will post an update.
0
 
gwlanksAuthor Commented:
Kimputer,

Thank you so very much for your help.  I tested against the test file and brought my data in and found the issues I am having.  When I created the test file there is an extra column between I and J that I omitted by accident.  Then there is an additional column between L and M with data also.

And then on the additional data that goes beyond the first record there is one additional column there.  So instead of copying 5 columns I need to copy 6 columns.  I am unsure the best way to adjust this macro to accommodate for this.  How would I go about implementing these 3 changes to make the macro work as needed?
0
 
KimputerCommented:
Just upload a file again, one sheet with data, one sheet with the result you want.
0
 
gwlanksAuthor Commented:
Attached is my spreadsheet as you requested.
test2.xlsx
0
 
gwlanksAuthor Commented:
I get the error message of variable not defined and highlights each time colscount =
0
 
KimputerCommented:
Start the code with only the Test Data sheet (delete others).
0
 
gwlanksAuthor Commented:
Tried that and still get the error.   Do you have anything set that I should change on my side to match to get the code to resolve?
0
 
gwlanksAuthor Commented:
I went in and DIM all possible variables and I think I have it.  Let me do some more testing and I think were in great shape.  Thank you so very much for your help.
0
 
gwlanksAuthor Commented:
After dimensioning a few variables it works great.  The assistance from Experts Exchange on this particular problem was awesome.  This is by far the best site I have ever used.
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.

All Courses

From novice to tech pro — start learning today.