Redistribute a Delimited Column Of Data into Separate Rows (Keeping Other Data As Is)
*** NOTE - Revised code posted August 12, 2013 in response ***
*** to a problem Marcelo Branco pointed out in Message #19 ***
The following scenario seems to come up somewhat often at the various forums I participate in... take a table of data where one column contains delimited data and split that delimited data so that each item is on a row of its own, copying the associated data into the blank cells created by the split. Visually, we want to go from this table...
|
A |
B |
C |
D |
| 1 |
Name |
Client
Number |
Parts
Ordered |
|
| 2 |
Rick |
1111111 |
P1, P2, P3 |
|
| 3 |
Sam |
2222222 |
P2, P5 |
|
| 4 |
Joe |
3333333 |
P3 |
|
| 5 |
Bill |
4444444 |
P4, P6, P7, P8 |
|
| 6 |
|
|
|
|
to this one
|
A |
B |
C |
D |
| 1 |
Name |
Client
Number |
Parts
Ordered |
|
| 2 |
Rick |
1111111 |
P1 |
|
| 3 |
Rick |
1111111 |
P2 |
|
| 4 |
Rick |
1111111 |
P3 |
|
| 5 |
Sam |
2222222 |
P2 |
|
| 6 |
Sam |
2222222 |
P5 |
|
| 7 |
Joe |
3333333 |
P3 |
|
| 8 |
Bill |
4444444 |
P4 |
|
| 9 |
Bill |
4444444 |
P6 |
|
| 10 |
Bill |
4444444 |
P7 |
|
| 11 |
Bill |
4444444 |
P8 |
|
| 12 |
|
|
|
|
Below is a macro that will accomplish this task. Note though that I have generalize it somewhat. Usually in the requests the delimited data is in the last column as shown above, however, there is no need for this to be the case... this macro will allow any column to be the delimited column.
Code:
Sub RedistributeData()
Dim X As Long, LastRow As Long, A As Range, Table As Range, Data() As String
Const Delimiter As String = ", "
Const DelimitedColumn As String = "C"
Const TableColumns As String = "A:C"
Const StartRow As Long = 2
Application.ScreenUpdating = False
LastRow = Columns(TableColumns).Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
For X = LastRow To StartRow Step -1
Data = Split(Cells(X, DelimitedColumn), Delimiter)
If UBound(Data) > 0 Then
Intersect(Rows(X + 1), Columns(TableColumns)).Resize(UBound(Data)).Insert xlShiftDown
End If
If Len(Cells(X, DelimitedColumn)) Then
Cells(X, DelimitedColumn).Resize(UBound(Data) + 1) = WorksheetFunction.Transpose(Data)
End If
Next
LastRow = Cells(Rows.Count, DelimitedColumn).End(xlUp).Row
On Error Resume Next
Set Table = Intersect(Columns(TableColumns), Rows(StartRow).Resize(LastRow - StartRow + 1))
If Err.Number = 0 Then
Table.SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
Columns(DelimitedColumn).SpecialCells(xlFormulas).Clear
Table.Value = Table.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
There are four constants (the Const statements) that you need to match to your actual worksheet conditions in order to work. The first is named Delimiter and it can be one or more characters long. The second is named DelimitedColumn and specifies the column letter containing the delimited cells. The third is named TableColumns and it specifies the columns occupied by your data (which must always include the column with the delimited cells. The last one is named StartRow and it specifies the row containing the first piece of data (that is, it is the row number below the headers, if any).
hi why this macro is not working.
Quote:
Originally Posted by
snb
Hi Rick
I tried to develop an alternative that doesn't need any writing into any worksheet. It will be done in memory completely (except writing the results of course).
You can see that I make use of all the special facilities that arrays offer us.
The macro is built on the example in this thread.
Code:
Sub M_snb()
sn = Sheets(1).Cells(1).CurrentRegion
For j = 1 To UBound(sn)
c00 = c00 & "|" & Replace(String(UBound(Split(sn(j, 3), ",")), "|"), "|", j & "|") & j
Next
sq = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), Evaluate("transpose(row(1:" & UBound(sn, 2) & "))"))
sp = Split(Join(Application.Transpose(Application.Index(sn, 0, 3)), ","), ",")
For j = 0 To UBound(sp)
sq(j + 1, 3) = sp(j)
Next
Cells(10, 1).Resize(UBound(sq), UBound(sq, 2)) = sq
End Sub
or another method:
Code:
Sub M_snb0()
sn = Split(Join([transpose(A2:A6 & "_" & B2:B6 & "_" & substitute(C2:C6,", ","," & A2:A6 & "_" & B2:B6 & "_"))], ","), ",")
Cells(20, 1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
Cells(20, 1).CurrentRegion.TextToColumns , , , , False, False, False, False, True, "_"
End Sub
Hi my problem is same like DAT only. but this macro is not working for issue. when apply the macro it's showing error Run-time error '1004': Application-defined or object-defined error.
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://eileenslounge.com/viewtopic.php?p=317218#p317218
https://eileenslounge.com/viewtopic.php?p=316955#p316955
https://eileenslounge.com/viewtopic.php?p=316955#p316955
https://eileenslounge.com/viewtopic.php?p=316940#p316940
https://eileenslounge.com/viewtopic.php?p=316927#p316927
https://eileenslounge.com/viewtopic.php?p=317014#p317014
https://eileenslounge.com/viewtopic.php?p=317006#p317006
https://eileenslounge.com/viewtopic.php?p=316935#p316935
https://eileenslounge.com/viewtopic.php?p=316875#p316875
https://eileenslounge.com/viewtopic.php?p=316254#p316254
https://eileenslounge.com/viewtopic.php?p=316280#p316280
https://eileenslounge.com/viewtopic.php?p=315915#p315915
https://eileenslounge.com/viewtopic.php?p=315512#p315512
https://eileenslounge.com/viewtopic.php?p=315744#p315744
https://www.eileenslounge.com/viewtopic.php?p=315512#p315512
https://eileenslounge.com/viewtopic.php?p=315680#p315680
https://eileenslounge.com/viewtopic.php?p=315743#p315743
https://www.eileenslounge.com/viewtopic.php?p=315326#p315326
https://www.eileenslounge.com/viewtopic.php?f=30&t=40752
https://eileenslounge.com/viewtopic.php?p=314950#p314950
https://www.eileenslounge.com/viewtopic.php?p=314940#p314940
https://www.eileenslounge.com/viewtopic.php?p=314926#p314926
https://www.eileenslounge.com/viewtopic.php?p=314920#p314920
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
That worked great, but...
Quote:
Originally Posted by
msrebraca
Trosko, you are having the same issue that I faced, your deliminated column "L" has some blanks so the code errors out. I removed the rows with blanks in column L and the macro ran just fine.
So you'll need to update the macro to account for this. I wasn't able to figure that part out and in my case it didn't matter, rows with blanks in the deliminated column were not needed for my project so I was able to just delete those rows by inserting the following code in the macro. You'll notice I put the new code right after the delclarations and before the existing code.
The modification worked great, but is there an easy to autofill the blanks with a value like "Null" rather than delete them?
Multiple multi-value columns
Hello. This macro works beautifully, however is there a way to do this same function to multiple columns with multi-values?
My data looks like this:
Column 1 Column 2 Multi-value Column Multi-value column
Data Data RMA;-;RMA 65044;99944;65033
The multi-values all correspond with each other.
This is a break down of service work orders, line items such as labor, travel, parts and if it is returnable.
Your help is greatly appreciated.
Almost exactly what I am looking for - but issue with blanks in end columns
Hi Rick,
This is great and is almost exactly what I am looking for. I have two (hopefully small) issues with the code though.
What I changed: I updated the range from A:C to be A:Z,and to start at Row 6 (headings in row 5) as per my data. Then have created the macro twice to once sperate column G and then next Column E. This works great (although I am sure you could do this in one - but it is beyond me to manipulate it that much).
Issue 1: comes when I look at the copied data results. Column U to Y have a heading in Row 5 but no data/are blank (they are for use later on). So no data should have been copied. But instead the code copies the headings from Row 5...?? ANy ideas on how to fix this?
Issue 2: comes when I have 2 columns column C+D that I need to split together - C is material number and D is material Name.
e.g
material number Material Name
100017, 100018 Mat A, Mat B
Should become
Mateiral Number Material Name
100017 Mat A
100018 Mat B
If I was to run the eixisting macro twice for Column C then D I would actually get after the first run
100017 Mat A, Mat B
100018 Mat A, Mat B
Then after the second run
100017 Mat A
100017 Mat B
100018 Mat A
100018 Mat B
Any ideas?
Many Thanks in advance!
The code works but it fills empty cells also
Hi Rick,
Great piece of code
i have a macro data file that contains empty cells too. when i run this code it fills all the empty cells to the values to the upper cell whether needed or not.i want to copy only those rows which have delimited values in the (delimited) column.
Can you help me fix the code so that i only creates new rows for the splited column.
A B C
a b,c,d l
k u
v,k i
The results should be:
A B C
a b l
a c l
a d l
k u
v i
k k
Thanks
Wajiha :)
