Need help to Transpose column into unique rows with comma delimited values

kdevine321

New Member
Joined
Nov 4, 2013
Messages
5
Hi,
I am trying to execute a script I copied from this site to transpose a column of values into unique rows. There was a very similar thread to my question, but the code does not work for my situation as I am a newbie to VBA. The referenced thread was http://www.mrexcel.com/forum/excel-...ranspose-multiple-comma-separated-values.html

I would like to comma delimit column "D" into unique rows per value while maintaining the relationship with the data in the other columns. Here is the example of my data:

[TABLE="width: 500"]
<tbody></tbody>[/TABLE]
[TABLE="width: 100"]
<tbody>[TR]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD="width: 137"]GA-AG-00010-A-2013[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"]Apache Hunting Club[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64, align: right"]709[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 179"]
<tbody>[TR]
[TD="class: xl19, width: 179"]36[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD="width: 137"]GA-AG-00020-A-2013[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"]Tiger Branch Hunt Club[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64, align: right"]1596[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 179"]
<tbody>[TR]
[TD="class: xl19, width: 179"]71, 72[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD="width: 137"]GA-AG-00030-A-2013[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"]Big "O" Hunting Club[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64, align: right"]3058[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 179"]
<tbody>[TR]
[TD="class: xl19, width: 179"]59, 64, 65, 75, 79, 84[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I want to make each value in Column D a unique row and still be associated with Column A-C. When I run this code I get a Runtime script error 9.

Sub SplitKeywords()
Dim MyArr, v As Long, i As Long, LR As Long
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row


For i = LR To 2 Step -1
MyArr = Split(Range("D" & i), ", ")
Range("D" & i) = MyArr(0)
For v = 1 To UBound(MyArr)
Rows(i + v).Insert xlShiftDown
Range("A" & i + v, "C" & i + v) = Range("A" & i, "C" & i).Value
Range("D" & i + v) = MyArr(v)
Next v
Next i


Application.ScreenUpdating = True
End Sub

Any ideas on how to correct this? My actual data spans from column A-Q and can place the "split values" in column Q.

Thanks!
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
kdevine321,

Welcome to the MrExcel forum.

Sample raw data:


Excel 2007
ABCD
1
2GA-AG-00010-A-2013Apache Hunting Club70936
3GA-AG-00020-A-2013Tiger Branch Hunt Club159671, 72
4GA-AG-00030-A-2013Big "O" Hunting Club305859, 64, 65, 75, 79, 84
5
6
7
8
9
10
11
Sheet1


After the macro:/b]


Excel 2007
ABCD
1
2GA-AG-00010-A-2013Apache Hunting Club70936
3GA-AG-00020-A-2013Tiger Branch Hunt Club159671
4GA-AG-00020-A-2013Tiger Branch Hunt Club159672
5GA-AG-00030-A-2013Big "O" Hunting Club305859
6GA-AG-00030-A-2013Big "O" Hunting Club305864
7GA-AG-00030-A-2013Big "O" Hunting Club305865
8GA-AG-00030-A-2013Big "O" Hunting Club305875
9GA-AG-00030-A-2013Big "O" Hunting Club305879
10GA-AG-00030-A-2013Big "O" Hunting Club305884
11
Sheet1


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
Option Explicit
Sub ReorgData()
' hiker95, 11/04/2013
' http://www.mrexcel.com/forum/excel-questions/737089-need-help-transpose-column-into-unique-rows-comma-delimited-values.html
Dim r As Long, lr As Long, s
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 2 Step -1
  If InStr(Trim(Cells(r, 4)), ",") > 0 Then
    s = Split(Trim(Cells(r, 4)), ", ")
    Rows(r + 1).Resize(UBound(s)).Insert
    Cells(r, 1).Resize(UBound(s) + 1, 3).Value = Cells(r, 1).Resize(, 3).Value
    Cells(r, 4).Resize(UBound(s) + 1).Value = Application.Transpose(s)
  End If
Next r
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.
 
Upvote 0
Thanks hiker95! This code does work on a subset of my data, so that's a huge start. And to answer your question, yes, my example data Column D is actually column Q in the real dataset I'm trying to manipulate. Unfortunately I can't understand your code enough to expand it out to Q. Could you help with this as well, maybe even put in a few comment lines to help me understand the logic?
 
Upvote 0
kdevine321,

Is this what your actual raw data looks like?


Excel 2007
ABCDEFGHIJKLMNOPQ
1Titles ABCDEFGHIJKLMNOPTitle Q
2GA-AG-00010-A-2013Apache Hunting Club70936efghijklmnop
3GA-AG-00020-A-2013Tiger Branch Hunt Club159671, 72efghijklmnop
4GA-AG-00030-A-2013Big "O" Hunting Club305859, 64, 65, 75, 79, 84efghijklmnop
5
Sheet1
 
Upvote 0
kdevine321,

Or, is this what your actual raw data looks like?


Excel 2007
ABCDEFGHIJKLMNOPQ
1Titles ABCDEFGHIJKLMNOPTitle Q
2GA-AG-00010-A-2013Apache Hunting Club709eefghijklmnop36
3GA-AG-00020-A-2013Tiger Branch Hunt Club1596eefghijklmnop71, 72
4GA-AG-00030-A-2013Big "O" Hunting Club3058eefghijklmnop59, 64, 65, 75, 79, 84
5
Sheet1
 
Upvote 0
kdevine321,

Sample raw data:


Excel 2007
ABCDEFGHIJKLMNOPQ
1Titles ABCDEFGHIJKLMNOPTitle Q
2GA-AG-00010-A-2013Apache Hunting Club70936efghijklmnop
3GA-AG-00020-A-2013Tiger Branch Hunt Club159671, 72efghijklmnop
4GA-AG-00030-A-2013Big "O" Hunting Club305859, 64, 65, 75, 79, 84efghijklmnop
5
6
7
8
9
10
11
Sheet1


After the macro:


Excel 2007
ABCDEFGHIJKLMNOPQ
1Titles ABCDEFGHIJKLMNOPTitle Q
2GA-AG-00010-A-2013Apache Hunting Club70936efghijklmnop36
3GA-AG-00020-A-2013Tiger Branch Hunt Club159671, 72efghijklmnop71
4GA-AG-00020-A-2013Tiger Branch Hunt Club159671, 72efghijklmnop72
5GA-AG-00030-A-2013Big "O" Hunting Club305859, 64, 65, 75, 79, 84efghijklmnop59
6GA-AG-00030-A-2013Big "O" Hunting Club305859, 64, 65, 75, 79, 84efghijklmnop64
7GA-AG-00030-A-2013Big "O" Hunting Club305859, 64, 65, 75, 79, 84efghijklmnop65
8GA-AG-00030-A-2013Big "O" Hunting Club305859, 64, 65, 75, 79, 84efghijklmnop75
9GA-AG-00030-A-2013Big "O" Hunting Club305859, 64, 65, 75, 79, 84efghijklmnop79
10GA-AG-00030-A-2013Big "O" Hunting Club305859, 64, 65, 75, 79, 84efghijklmnop84
11
Sheet1


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:
Option Explicit
Sub ReorgDataV2()
' hiker95, 11/04/2013
' http://www.mrexcel.com/forum/excel-questions/737089-need-help-transpose-column-into-unique-rows-comma-delimited-values.html
Dim r As Long, lr As Long, s
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 2 Step -1
  If InStr(Trim(Cells(r, 4)), ",") = 0 Then
    Cells(r, 17).Value = Cells(r, 4).Value
  ElseIf InStr(Trim(Cells(r, 4)), ",") > 0 Then
    s = Split(Trim(Cells(r, 4)), ", ")
    Rows(r + 1).Resize(UBound(s)).Insert
    Cells(r, 1).Resize(UBound(s) + 1, 16).Value = Cells(r, 1).Resize(, 16).Value
    Cells(r, 17).Resize(UBound(s) + 1).Value = Application.Transpose(s)
  End If
Next r
End Sub


Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgDataV2 macro.
 
Upvote 0

Forum statistics

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

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