Page 1 of 4 123 ... LastLast
Results 1 to 10 of 35

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

  1. #1
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    659
    Rep Power
    13

    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).
    Last edited by Rick Rothstein; 08-12-2013 at 09:31 PM.

  2. #2
    Senior Member
    Join Date
    Jun 2012
    Posts
    337
    Rep Power
    12
    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

    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgzMCQUIQgrbec400jl4AaABAg
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwhVTFaD469mW9wO194AaABAg. 9gJzxwFcnPU9gORqKw5tW_
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugyb8nmKKoXvcdM58gV4AaABAg
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwvvXcl1oa79xS7BAV4AaABAg
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgxvIFArksPprylHXYZ4AaABAg
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 07-11-2023 at 12:54 PM.

  3. #3
    Junior Member
    Join Date
    Apr 2013
    Posts
    2
    Rep Power
    0

    hi why this macro is not working.

    Quote Originally Posted by snb View Post
    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.

  4. #4
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    659
    Rep Power
    13
    Quote Originally Posted by venkatgoutham View Post
    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.
    You quote the code that 'snb' posted in response to my article, so I'll let him deal with your question (whenever he next checks into this thread) as it relates to his code, but I was wondering if you tried the code I posted in main article and whether you had problems using it as well?

  5. #5
    Junior Member
    Join Date
    Apr 2013
    Posts
    2
    Rep Power
    0
    Quote Originally Posted by Rick Rothstein View Post
    You quote the code that 'snb' posted in response to my article, so I'll let him deal with your question (whenever he next checks into this thread) as it relates to his code, but I was wondering if you tried the code I posted in main article and whether you had problems using it as well?
    yep i tried. it's working fine which u posted in main article .yesterday it's working fine for me. but today i am getting error (which i told in previous quote). so i have to know one thing. which times that error come. what i need check whether it's error came.


    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://www.youtube.com/watch?v=SIDLFRkUEIo&lc=UgzTF5vvB67Zbfs9qvx4AaABAg
    https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgxLtKj969oiIu7zNb94AaABAg
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgzMCQUIQgrbec400jl4AaABAg
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugx12mI-a39T41NaZ8F4AaABAg.9iDQqIP56NV9iFD0AkeeJG
    https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugxa2VYHMWJWXA6QI294AaABAg. 9irLgSdeU3r9itU7zdnWHw
    https://www.youtube.com/watch?v=tPRv-ATUBe4&lc=UgzFkoI0n_BxwnwVMcZ4AaABAg
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9htG01cKBzX
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htJ6TpIOXR
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwMKwGZpDjv7vi7pCx4AaABAg
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htOKs4jh3M
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxVW-am20rQ5GFuJ9F4AaABAg
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 10-24-2023 at 02:55 PM.

  6. #6
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    659
    Rep Power
    13
    Quote Originally Posted by venkatgoutham View Post
    yep i tried. it's working fine which u posted in main article .yesterday it's working fine for me. but today i am getting error (which i told in previous quote). so i have to know one thing. which times that error come. what i need check whether it's error came.
    Can you attach a copy of the workbook that is giving you the error so that I can test the code out on your exact data to see where the problem is located at?

  7. #7
    Senior Member
    Join Date
    Jun 2012
    Posts
    337
    Rep Power
    12
    I hope it's obvious that:
    - this macro resides in the macromodule it refers to
    - the ranges (A1:A6, B1:B6, etc.) have to be adapted to your specific situation
    - the delimiter in column C is ", " and may have to be adapted to your specific situation

    Code:
    Sub M_snb()
        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
    Your feedback is too limited to analyse what could have caused the error.
    Posting a sample workbook could shed some more light.
    Last edited by snb; 06-27-2014 at 01:45 PM.

  8. #8
    Junior Member
    Join Date
    May 2013
    Posts
    6
    Rep Power
    0
    Hi Rick,

    I tried to use your macro and after updating the 4 constants I get a runtime error 1004 on the following line.

    Intersect(Rows(X + 1), Columns(TableColumns)).Resize(UBound(Data)).Insert xlShiftDown

  9. #9
    Junior Member
    Join Date
    May 2013
    Posts
    6
    Rep Power
    0
    I only changed the constants to:

    Const Delimiter As String = ";#"
    Const DelimitedColumn As String = "D"
    Const TableColumns As String = "A:D"
    Const StartRow As Long = 2

    Any ideas what could trigger the error on that line?

  10. #10
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    659
    Rep Power
    13
    Can you attach a sample file (that fails to work) to a response so that I can see what is happening directly? To attach a file, I think you would click the Reply link in the bottom border of this message and then click the "Go Advanced" button under the new reply box that appears... somewhere below that new reply box should be a button that will allow you to upload a file as an attachment.

Similar Threads

  1. Move data from rows into columns for every unique value
    By mahmoud-lee in forum Excel Help
    Replies: 4
    Last Post: 06-13-2013, 03:02 AM
  2. Replies: 4
    Last Post: 05-01-2013, 09:49 PM
  3. Replies: 3
    Last Post: 03-16-2013, 05:13 PM
  4. Replies: 12
    Last Post: 08-19-2012, 06:17 PM
  5. Transpose data into Rows
    By vikash200418 in forum Excel Help
    Replies: 2
    Last Post: 04-10-2012, 11:02 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •