multiple cell entries to become multiple Row entries?

C

Crazyivan76

New Member
Joined
May 15, 2014
Messages
2
Greetings all.


I'm a bit of a neophyte when it comes to coding in VB for Excel. I've seen other posts (re: Multiple entries in one cell, split to multiple rows?) but have a dilemma that is similar. I suspect that it will use a form of the macro posted in this thread
http://www.mrexcel.com/forum/excel-...ple-entries-one-cell-split-multiple-rows.html

I dont want to basically transpose multiple columns cells into a single row into multiple row cells in a single column. I've 500 row entries that will then explode at an alarming rate.


I am currently using Excel 2013

I have a row with multiple columns. The row start off and is fixed to a point because its customer data
Market MemberID LASTNAME FIRSTNAME DOB GENDER ADDRESS CITY STATE ZIP PHONE COUNTY

The last column in the row(s) is PRODUCT. Here I have my dilemma . Product can have multiple cells in the row and each row for each customer can be of an indeterminate size. The PRODUCT colum
Short Example

CUSTOMER INFO ROWS ---- PRODUCT
Row1 John's info blahblahblah Cats Dogs Birds Pigs Cars (each entry after product is a seperate column/cell)
Row2 Jane's info blahblahblah Tickets Barn Shotgun

[TABLE="width: 1251"]
<tbody>[TR]
[TD]Market[/TD]
[TD]MEMBER ID[/TD]
[TD]LAST NAME[/TD]
[TD]FIRST NAME[/TD]
[TD]DOB[/TD]
[TD]GENDER[/TD]
[TD]ADDRESS 1[/TD]
[TD]ADDRESS 2[/TD]
[TD]CITY[/TD]
[TD]STATE[/TD]
[TD]ZIP[/TD]
[TD]PHONE[/TD]
[TD]COUNTY[/TD]
[TD]PRODUCT[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]North[/TD]
[TD="align: right"]1234[/TD]
[TD]John[/TD]
[TD]Doe[/TD]
[TD="align: right"]1/1/1970[/TD]
[TD]M[/TD]
[TD="colspan: 2"]123 nowhere[/TD]
[TD]dallas[/TD]
[TD]texas[/TD]
[TD="align: right"]21312[/TD]
[TD="align: right"]12313[/TD]
[TD="align: right"]12132[/TD]
[TD]Apples and candy[/TD]
[TD]orange[/TD]
[TD]cars and squirrels[/TD]
[TD]baseballs[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]South[/TD]
[TD="align: right"]3214[/TD]
[TD]Jane[/TD]
[TD]Smith[/TD]
[TD="align: right"]2/5/1971[/TD]
[TD]f[/TD]
[TD="colspan: 2"]321 somewhere[/TD]
[TD]San antonio[/TD]
[TD]texas[/TD]
[TD="align: right"]31215[/TD]
[TD="align: right"]12333[/TD]
[TD="align: right"]12333[/TD]
[TD] Cats[/TD]
[TD]dogs[/TD]
[TD]pigs[/TD]
[TD]horses[/TD]
[TD]birds[/TD]
[TD]hammers[/TD]
[/TR]
</tbody>[/TABLE]

I would like to turn this into something like this

[TABLE="width: 931"]
<tbody>[TR]
[TD="colspan: 3"]WHAT I'D LIKE IT TO BECOME[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]North[/TD]
[TD="align: right"]1234[/TD]
[TD]John[/TD]
[TD]Doe[/TD]
[TD="align: right"]1/1/1970[/TD]
[TD]M[/TD]
[TD="colspan: 2"]123 nowhere[/TD]
[TD]dallas[/TD]
[TD]texas[/TD]
[TD="align: right"]21312[/TD]
[TD="align: right"]12313[/TD]
[TD="align: right"]12132[/TD]
[TD] Apples and candy[/TD]
[/TR]
[TR]
[TD]North[/TD]
[TD="align: right"]1234[/TD]
[TD]John[/TD]
[TD]Doe[/TD]
[TD="align: right"]1/1/1970[/TD]
[TD]M[/TD]
[TD="colspan: 2"]123 nowhere[/TD]
[TD]dallas[/TD]
[TD]texas[/TD]
[TD="align: right"]21312[/TD]
[TD="align: right"]12313[/TD]
[TD="align: right"]12132[/TD]
[TD] orange[/TD]
[/TR]
[TR]
[TD]North[/TD]
[TD="align: right"]1234[/TD]
[TD]John[/TD]
[TD]Doe[/TD]
[TD="align: right"]1/1/1970[/TD]
[TD]M[/TD]
[TD="colspan: 2"]123 nowhere[/TD]
[TD]dallas[/TD]
[TD]texas[/TD]
[TD="align: right"]21312[/TD]
[TD="align: right"]12313[/TD]
[TD="align: right"]12132[/TD]
[TD]cars and squirrels[/TD]
[/TR]
[TR]
[TD]North[/TD]
[TD="align: right"]1234[/TD]
[TD]John[/TD]
[TD]Doe[/TD]
[TD="align: right"]1/1/1970[/TD]
[TD]M[/TD]
[TD="colspan: 2"]123 nowhere[/TD]
[TD]dallas[/TD]
[TD]texas[/TD]
[TD="align: right"]21312[/TD]
[TD="align: right"]12313[/TD]
[TD="align: right"]12132[/TD]
[TD]baseballs[/TD]
[/TR]
[TR]
[TD]South[/TD]
[TD="align: right"]3214[/TD]
[TD]Jane[/TD]
[TD]Smith[/TD]
[TD="align: right"]2/5/1971[/TD]
[TD]f[/TD]
[TD="colspan: 2"]321 somewhere[/TD]
[TD]San antonio[/TD]
[TD]texas[/TD]
[TD="align: right"]31215[/TD]
[TD="align: right"]12333[/TD]
[TD="align: right"]12333[/TD]
[TD] Cats[/TD]
[/TR]
[TR]
[TD]South[/TD]
[TD="align: right"]3214[/TD]
[TD]Jane[/TD]
[TD]Smith[/TD]
[TD="align: right"]2/5/1971[/TD]
[TD]f[/TD]
[TD="colspan: 2"]321 somewhere[/TD]
[TD]San antonio[/TD]
[TD]texas[/TD]
[TD="align: right"]31215[/TD]
[TD="align: right"]12333[/TD]
[TD="align: right"]12333[/TD]
[TD] dogs[/TD]
[/TR]
[TR]
[TD]South[/TD]
[TD="align: right"]3214[/TD]
[TD]Jane[/TD]
[TD]Smith[/TD]
[TD="align: right"]2/5/1971[/TD]
[TD]f[/TD]
[TD="colspan: 2"]321 somewhere[/TD]
[TD]San antonio[/TD]
[TD]texas[/TD]
[TD="align: right"]31215[/TD]
[TD="align: right"]12333[/TD]
[TD="align: right"]12333[/TD]
[TD] pigs[/TD]
[/TR]
[TR]
[TD]South[/TD]
[TD="align: right"]3214[/TD]
[TD]Jane[/TD]
[TD]Smith[/TD]
[TD="align: right"]2/5/1971[/TD]
[TD]f[/TD]
[TD="colspan: 2"]321 somewhere[/TD]
[TD]San antonio[/TD]
[TD]texas[/TD]
[TD="align: right"]31215[/TD]
[TD="align: right"]12333[/TD]
[TD="align: right"]12333[/TD]
[TD] horses[/TD]
[/TR]
[TR]
[TD]South[/TD]
[TD="align: right"]3214[/TD]
[TD]Jane[/TD]
[TD]Smith[/TD]
[TD="align: right"]2/5/1971[/TD]
[TD]f[/TD]
[TD="colspan: 2"]321 somewhere[/TD]
[TD]San antonio[/TD]
[TD]texas[/TD]
[TD="align: right"]31215[/TD]
[TD="align: right"]12333[/TD]
[TD="align: right"]12333[/TD]
[TD] birds[/TD]
[/TR]
[TR]
[TD]South[/TD]
[TD="align: right"]3214[/TD]
[TD]Jane[/TD]
[TD]Smith[/TD]
[TD="align: right"]2/5/1971[/TD]
[TD]f[/TD]
[TD="colspan: 2"]321 somewhere[/TD]
[TD]San antonio[/TD]
[TD]texas[/TD]
[TD="align: right"]31215[/TD]
[TD="align: right"]12333[/TD]
[TD="align: right"]12333[/TD]
[TD] hammers[/TD]
[/TR]
</tbody>[/TABLE]


As to how this can be achieved, I do not know. I'm half tempted to just slog through it (well, I am) and transpose the data by hand then autofill until I start the next entry, but I know there's got to be a better way to do this. Any assistance would be greatly appreciated.
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Sort by date Sort by votes
Assumes your header row is row 1 and first header is in A1 - adjust to suit:
Code: 
Sub DataRearrange()
Dim lR As Long, lC As Long, i As Long, Ct As Long, vA() As Variant
lR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = Range("A1:A" & lR).Rows.Count To 2 Step -1
    lC = Cells(i, Columns.Count).End(xlToLeft).Column
    Ct = WorksheetFunction.CountA(Range(Cells(i, "N"), Cells(i, lC)))
    If Ct > 1 Then
        Cells(i, "A").Offset(1, 0).Resize(Ct - 1, 1).EntireRow.Insert
        Range("A" & i, "M" & i + Ct - 1).FillDown
        ReDim vA(1 To Ct - 1)
        vA = Range(Cells(i, "O"), Cells(i, lC)).Value
        Range(Cells(i, "O"), Cells(i, lC)).ClearContents
        Cells(i + 1, "N").Resize(Ct - 1, 1).Value = WorksheetFunction.Transpose(vA)
    End If
Next i
Columns("N").AutoFit
Application.ScreenUpdating = True
End Sub
 
Upvote 0
I appreacite the help JoeMo. I attempted to run this and ended up with some inconsistancies. Upon looking, I had to adjust for difference in rows. The example i gave was a truncated version of the DB I am working in. My actual DB has demographic information from A to S and T is the start of the Product column/cells. I changed the strings then to contain the following changes

N became T O became U M became S

And the new VB/Macro/Script/thing became

Sub DataRearrange()
Dim lR As Long, lC As Long, i As Long, Ct As Long, vA() As Variant
lR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = Range("A1:A" & lR).Rows.Count To 2 Step -1
lC = Cells(i, Columns.Count).End(xlToLeft).Column
Ct = WorksheetFunction.CountA(Range(Cells(i, "T"), Cells(i, lC)))
If Ct > 1 Then
Cells(i, "A").Offset(1, 0).Resize(Ct - 1, 1).EntireRow.Insert
Range("A" & i, "T" & i + Ct - 1).FillDown
ReDim vA(1 To Ct - 1)
vA = Range(Cells(i, "S"), Cells(i, lC)).Value
Range(Cells(i, "U"), Cells(i, lC)).ClearContents
Cells(i + 1, "T").Resize(Ct - 1, 1).Value = WorksheetFunction.Transpose(vA)
End If
Next i
Columns("T").AutoFit
Application.ScreenUpdating = True
End Sub


You, good sir, just saved me 5 hours of grunt copy n paste work that I had resigned myself to toiling away at over the weekend. If you lived in the Tampa FL area, I'd be buying you a beer right now.

Edit: There's some fragmentation in the end result, but honestly, I would rather clean up 500 random entries than create 170k rows of data. Thanks again
 
Last edited:
Upvote 0
Crazyivan76 said:
I appreacite the help JoeMo. I attempted to run this and ended up with some inconsistancies. Upon looking, I had to adjust for difference in rows. The example i gave was a truncated version of the DB I am working in. My actual DB has demographic information from A to S and T is the start of the Product column/cells. I changed the strings then to contain the following changes

N became T O became U M became S

And the new VB/Macro/Script/thing became

Sub DataRearrange()
Dim lR As Long, lC As Long, i As Long, Ct As Long, vA() As Variant
lR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = Range("A1:A" & lR).Rows.Count To 2 Step -1
lC = Cells(i, Columns.Count).End(xlToLeft).Column
Ct = WorksheetFunction.CountA(Range(Cells(i, "T"), Cells(i, lC)))
If Ct > 1 Then
Cells(i, "A").Offset(1, 0).Resize(Ct - 1, 1).EntireRow.Insert
Range("A" & i, "T" & i + Ct - 1).FillDown
ReDim vA(1 To Ct - 1)
vA = Range(Cells(i, "S"), Cells(i, lC)).Value
Range(Cells(i, "U"), Cells(i, lC)).ClearContents
Cells(i + 1, "T").Resize(Ct - 1, 1).Value = WorksheetFunction.Transpose(vA)
End If
Next i
Columns("T").AutoFit
Application.ScreenUpdating = True
End Sub


You, good sir, just saved me 5 hours of grunt copy n paste work that I had resigned myself to toiling away at over the weekend. If you lived in the Tampa FL area, I'd be buying you a beer right now.

Edit: There's some fragmentation in the end result, but honestly, I would rather clean up 500 random entries than create 170k rows of data. Thanks again
Click to expand...
You are welcome - thanks for the reply.
 
Upvote 0
You must log in or register to reply here.

Similar threads

SOLTEC
  • Question Question
Import CSV Problem with single row multiple records for each entry
Replies
1
Views
811
Peter_SSs
Peter_SSs
T
  • Question Question
find today's date in cell, copy row and append to sheet 2
Replies
2
Views
925
TurboBDogg
T

Forum statistics

Threads
1,223,236
Messages
6,170,906
Members
452,366
Latest member
TePunaBloke

Share this page

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