Redistribute a Delimited Column Of Data into Separate Rows (Keeping Other Data As Is)

**madaboutmygirls** · 07-30-2014, 03:57 AM

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!

**aselcuks** · 09-25-2014, 05:44 PM

Originally Posted by Rick Rothstein

*** 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, There occurs a problem with the other columns. Some of the columns are not fully completed, I mean half of the column has something in it and the other half is empty. When I run the code, it fullfills the other rest of the column with the value of last unempty cell. It stretches the last cell to the length of the longest column. Does any body have an idea with this code to fix it?

Thanks in advance,
Regards,

**Rick Rothstein** · 09-26-2014, 07:29 AM

Originally Posted by aselcuks

When I run the code, it fullfills the other rest of the column with the value of last unempty cell. It stretches the last cell to the length of the longest column. Does any body have an idea with this code to fix it?

That is how the code was designed. When data is missing and the user wants to fill it in, normally they want to do that fill for the data item and, since there is no way to know how far that last item should be filled for, I chose to use the row with the last data item as the stopping point. Until your post, that is the functionality everyone has wanted. If you post a sample worksheet with existing data on Sheet1 and what you want that data to look like on Sheet2, I will try to modify the code for you to do what you show me you want.

**aselcuks** · 09-26-2014, 10:24 AM

Originally Posted by Rick Rothstein

That is how the code was designed. When data is missing and the user wants to fill it in, normally they want to do that fill for the data item and, since there is no way to know how far that last item should be filled for, I chose to use the row with the last data item as the stopping point. Until your post, that is the functionality everyone has wanted. If you post a sample worksheet with existing data on Sheet1 and what you want that data to look like on Sheet2, I will try to modify the code for you to do what you show me you want.

MMVAL V1_BOM.xls

That is the sheet I wanna modify and after the code executed I want it to be like;

MMVAL V1_BOM_modified.xls

but It fullfills the rest of column K with the last statement "C15" and it goes down to length of longest column.

Thank you for your concern.

Regards

**aselcuks** · 09-26-2014, 10:30 AM

Originally Posted by aselcuks

MMVAL V1_BOM.xls

That is the sheet I wanna modify and after the code executed I want it to be like;

MMVAL V1_BOM_modified.xls

but It fullfills the rest of column K with the last statement "C15" and it goes down to length of longest column.

Thank you for your concern.

Regards

Also if there is any blank cell lets say G20, after execution it fulfills the shifted cell of G20 with the value of G19, it doesnt leave it blank as it was before.

**snb** · 10-02-2014, 07:22 PM

Code:

Sub M_snb()
    sn = Sayfa1.Cells(1).CurrentRegion
    sp = Split(Join(Application.Transpose(Application.Index(sn, 0, 4)), ","), ",")

    c00 = "1_"
    For j = 2 To UBound(sn)
       c00 = c00 & Replace(Space(sn(j, 3)), " ", j & "_")
    Next
    st = Application.Index(sn, Application.Transpose(Split(c00, "_")), [transpose(row(1:12))])
    
    For j = 2 To UBound(st) - 1
       st(j, 4) = sp(j - 1)
    Next
    
    Sayfa1.Cells(40, 1).Resize(UBound(st) - 1, UBound(st, 2)) = st
End Sub

**Aisha13** · 10-16-2014, 01:16 PM

Originally Posted by Rick Rothstein

*** 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 Rick,

I'm trying to do something similar. I have an excel with 45 columns. there are 5 or 6 columns with Commas that I want to split into a new row. Below you can find the code that I have so far:

Code:

Sub SplitData()
    Dim arrColC As Variant
    Dim arrColm As Variant
    Dim arrColw As Variant
    Dim arrColz As Variant
    Dim arrCole As Variant
    Dim arrColh As Variant
    Dim shDATA As Worksheet
    Dim r As Long, c As Long, i As Long, m As Long, x As Long, w As Long, j As Long, a As Long, z As Long, b As Long, e As Long, d As Long, n As Long, k As Long, y As Long, h As Long
    
    
    Set shDATA = Sheets("owssvr")
    Dim MyRange As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each MyRange In ActiveSheet.UsedRange
    If 0 < InStr(MyRange, Chr(10)) Then
    MyRange = Replace(MyRange, Chr(10), ",")
    End If
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("SPLIT SHEET").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Sheets.Add After:=shDATA
    ActiveSheet.Name = "SPLIT SHEET"
    
    i = 1
    j = 1
a = 1
b = 1
 e = 1
 n = 1
 y = 1
     For r = 1 To shDATA.Cells(Rows.Count, "A").End(xlUp).Row
  
         arrColC = Split(shDATA.Cells(r, 5), ",")
       arrColm = Split(shDATA.Cells(r, 13), ",")
        arrColw = Split(shDATA.Cells(r, 14), ",")
        arrColz = Split(shDATA.Cells(r, 15), ",")
     arrCole = Split(shDATA.Cells(r, 16), ",")
     arrColh = Split(shDATA.Cells(r, 17), ",")
     arrColn = Split(shDATA.Cells(r, 45), ",")
        For c = 0 To UBound(arrColC)
            Cells(i, 1) = shDATA.Cells(r, 1)
            Cells(i, 2) = shDATA.Cells(r, 2)
            Cells(i, 3) = shDATA.Cells(r, 3)
            Cells(i, 4) = Format(shDATA.Cells(r, 4), "d-mmm-yy")
            Cells(i, 5) = arrColC(c)
     
         i = i + 1
                   
             For m = 0 To UBound(arrColm)
            Cells(j, 6) = shDATA.Cells(r, 6)
            Cells(j, 7) = shDATA.Cells(r, 7)
                Cells(j, 8) = Format(shDATA.Cells(r, 8), "d-mmm-yy")
                Cells(j, 9) = Format(shDATA.Cells(r, 9), "d-mmm-yy")
                Cells(j, 10) = shDATA.Cells(r, 10)
                Cells(j, 11) = shDATA.Cells(r, 11)
              Cells(j, 12) = shDATA.Cells(r, 12)
                 Cells(j, 13) = arrColm(m)
                  
                
                j = j + 1
                     Next m
    
            For w = 0 To UBound(arrColw)
             Cells(a, 14) = arrColw(w)
   
               a = a + 1

            Next w
       
        For z = 0 To UBound(arrColz)
             Cells(b, 15) = arrColz(z)
   
    
                b = b + 1
     Next z
     For d = 0 To UBound(arrCole)
             Cells(e, 16) = arrCole(d)
            
                
                e = e + 1
        
                       Next d
                            
        For h = 0 To UBound(arrColh)
             Cells(y, 17) = arrColh(h)
          
                
                y = y + 1
   
                        
                       Next h
                   
        For k = 0 To UBound(arrColn)
         
                     Cells(n, 18) = shDATA.Cells(r, 18)
   Cells(n, 19) = shDATA.Cells(r, 19)
   Cells(n, 20) = shDATA.Cells(r, 20)
   Cells(n, 21) = shDATA.Cells(r, 21)
   Cells(n, 22) = shDATA.Cells(r, 22)
    Cells(n, 23) = shDATA.Cells(r, 23)
     Cells(n, 24) = shDATA.Cells(r, 24)
      Cells(n, 25) = shDATA.Cells(r, 25)
       Cells(n, 26) = shDATA.Cells(r, 26)
        Cells(n, 27) = shDATA.Cells(r, 27)
         Cells(n, 28) = shDATA.Cells(r, 28)
          Cells(n, 29) = shDATA.Cells(r, 29)
           Cells(n, 30) = shDATA.Cells(r, 30)
            Cells(n, 31) = shDATA.Cells(r, 31)
             Cells(n, 32) = shDATA.Cells(r, 32)
              Cells(n, 33) = shDATA.Cells(r, 33)
               Cells(n, 34) = shDATA.Cells(r, 34)
                Cells(n, 35) = shDATA.Cells(r, 35)
                 Cells(n, 36) = shDATA.Cells(r, 36)
                  Cells(n, 37) = shDATA.Cells(r, 37)
                   Cells(n, 38) = shDATA.Cells(r, 38)
                    Cells(n, 39) = shDATA.Cells(r, 39)
                     Cells(n, 40) = shDATA.Cells(r, 40)
                      Cells(n, 41) = shDATA.Cells(r, 41)
                       Cells(n, 42) = shDATA.Cells(r, 42)
                          Cells(n, 44) = Format(shDATA.Cells(r, 44), "d-mmm-yy")
   
                         Cells(n, 45) = shDATA.Cells(r, 45)
  
            n = n + 1
            
                Next k
              
                 Next c
                              Next r
      
    
End Sub

the problem is that there are some columns missing when I try to run the macro:
1. Last row have missing cells. It get split correctly because of column 13, however it got empty cells from column 1 until 5
2. column 18 is not copied correctly
3. the remaining columns after column 17 is not correct

I think its with the loop somehow, can you please help me out? also there is one column which got comma that I want to exclude and not to include in the split because in this case this column need to be splited after the second column for example:

1. A, B , C, D

need to be

A, B
C, D

thanks a lot for your help

**Wajiha** · 11-25-2014, 10:26 AM

A B C
a b,c,d l
k u
v,k i
desired Output

A B C
a b l
a c l
a d l
k u
v i
k i
Here's the clearer view of my problem

Thanks

**tunderwat** · 02-24-2015, 08:05 PM

Thanks Rick! I was running into trouble with something similar and found your macro. All I did was change Const Delimiter As String = ", " to Const Delimiter As String = "|" and the macro helped split up my data! Thank you!