Page 4 of 4 FirstFirst ... 234
Results 31 to 35 of 35

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

  1. #31
    Junior Member
    Join Date
    Oct 2014
    Posts
    1
    Rep Power
    0

    Question

    Quote Originally Posted by Rick Rothstein View Post
    *** 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

  2. #32
    Junior Member
    Join Date
    Nov 2014
    Posts
    2
    Rep Power
    0

    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

  3. #33
    Junior Member
    Join Date
    Nov 2014
    Posts
    2
    Rep Power
    0
    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

  4. #34
    Junior Member
    Join Date
    Feb 2015
    Posts
    1
    Rep Power
    0
    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!

  5. #35
    Junior Member
    Join Date
    Mar 2015
    Posts
    1
    Rep Power
    0
    I felt that I had to tell you that this is incredibly useful, and I thank you very much.

    But to avoid falling foul of the rule "4. DO NOT post one liners thanking members or post remarks like "Wow, this is helpful", or "This is great" etc.", my situation has one additional requirement that you might be willing to look at.

    In the table in post #1, the delimited "Parts Ordered" column has different data in each cell. Would it be possible to get the macro to skip a row entirely, if the "Parts Ordered" delimited data in row x is the same as in row (x-1)?

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
  •