Page 2 of 4 FirstFirst 1234 LastLast
Results 11 to 20 of 35

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

  1. #11
    Junior Member
    Join Date
    May 2013
    Posts
    6
    Rep Power
    0

    tblScrubbedData

    Hi Rick,

    I have attached the file for your review. The file was too large to attach so I stripped most of the data leaving enough for you to work with. Also I changed the delimiter to ", " using the replace all function, was hoping that would help but it did not.

    The other part that I was not sure of was where to place the macro, in the worksheet or module either way I get an error. The attachment currently has it in the module.

    Thanks for taking a look:-)
    Attached Files Attached Files

  2. #12

  3. #13
    Junior Member
    Join Date
    Jul 2013
    Posts
    4
    Rep Power
    0

    Trouble with this Macro

    I'm trying to apply this macro to a spreadsheet that I have, but I'm having some issues. I keep getting a run time error. I've attached the file so that you can see what I'm working on.

    Thanks for any help that you can lend!
    Attached Files Attached Files

  4. #14
    Junior Member
    Join Date
    May 2013
    Posts
    6
    Rep Power
    0
    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.

    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 = "D"
      Const TableColumns As String = "A:D"
      Const StartRow As Long = 2
      
    Columns(4).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Last edited by Excel Fox; 08-18-2013 at 08:41 PM. Reason: Code tag added

  5. #15
    Junior Member
    Join Date
    Jul 2013
    Posts
    4
    Rep Power
    0

    That worked great, but...

    Quote Originally Posted by msrebraca View Post
    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?

  6. #16
    Junior Member
    Join Date
    Jul 2013
    Posts
    4
    Rep Power
    0

    One more thing...

    Things seem to go a little "wonky" when I hit 1179 rows - the macro still separates the rows, but it stops copying the information. Anyone have any idea why that might happen? Thanks!

  7. #17
    Junior Member
    Join Date
    May 2013
    Posts
    6
    Rep Power
    0
    You can select the range of cells in question and then use ctrl+F and the Replace All function to look for blanks and replace with NULL. Then run the original macro without the code that deletes the blanks.

  8. #18
    Junior Member
    Join Date
    Jul 2013
    Posts
    4
    Rep Power
    0

    Red face

    Quote Originally Posted by msrebraca View Post
    You can select the range of cells in question and then use ctrl+F and the Replace All function to look for blanks and replace with NULL. Then run the original macro without the code that deletes the blanks.
    Thanks! I knew there would be something really easy that I wasn't thinking of.

  9. #19
    Junior Member
    Join Date
    Aug 2013
    Posts
    4
    Rep Power
    0
    Hi Rick,

    Excellent code, I must say, but I found a problem if, for any reason, a customer has the column C blank.

    Something like (Joe has no Parts)

    Name Client Parts
    Rick 1111111 P1, P2, P3
    Sam 2222222 P2, P5
    Joe 3333333
    Bill 4444444 P4, P6, P7, P8


    This line of code throws an error

    Code:
      Intersect (Rows (X + 1), Columns (TableColumns)). Resize (UBound (Data)). XlShiftDown Insert

    The solution I found is (modifications in blue)

    Code:
    Sub RedistributeDataV2()
      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) And UBound(Data) <> -1 Then
          Intersect(Rows(X + 1), Columns(TableColumns)).Resize(UBound(Data)).Insert xlShiftDown
          Cells(X, DelimitedColumn).Resize(UBound(Data) + 1) = WorksheetFunction.Transpose(Data)
        End If
      
      Next
      LastRow = Cells(Rows.Count, DelimitedColumn).End(xlUp).Row
      
      On Error GoTo NoBlanks
      Set Table = Intersect(Columns(TableColumns), Rows(StartRow) _
        .Resize(LastRow - StartRow + 1, Columns(TableColumns).Columns.Count - 1))  
     On Error GoTo 0
    
      For Each A In Table.SpecialCells(xlBlanks).Areas
            A.FormulaR1C1 = "=R[-1]C"
            A.Value = A.Value
      Next
    NoBlanks:
      Application.ScreenUpdating = True
    End Sub

    This is reasonable or is there another more efficient solution?

    Best Regards,

    Marcelo

  10. #20
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13
    Quote Originally Posted by Marcelo Branco View Post
    Hi Rick,

    Excellent code, I must say, but I found a problem if, for any reason, a customer has the column C blank.

    Something like (Joe has no Parts)

    Name Client Parts
    Rick 1111111 P1, P2, P3
    Sam 2222222 P2, P5
    Joe 3333333
    Bill 4444444 P4, P6, P7, P8

    This line of code throws an error

    Code:
      Intersect (Rows (X + 1), Columns (TableColumns)). Resize (UBound (Data)). XlShiftDown Insert
    Thank you so much for pointing out this problem to me... I cannot believe it did not occur to me to test data where one or more of the cells are emptly. And thank you for your code suggestion as well; however, I decided to take a different route in fixing the problem. Your alert to me allowed me to review my code with "fresh eyes" and I saw a way to correct the problem while at the same time tighten up the code somewhat (I managed to eliminate the last For..Next loop entirely). I replaced the original code in Message #1 with my new code and put a note at the top indicating that message contains revised code (for those who previously visited this thread and then re-visit it in the future). Thank you again for pointing out the problem to me... I really appreciated it.

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
  •