How to split single text cell into multiple rows, using a comma delimiter?

[Bond007]

Hello - could anyone help me? I have a string of text in one cell on Sheet 1 (ie., A1, Sheet 1), here is a excerpt:

A-dec International Inc., A. Bellotti, A. DEPPELER S.A., etc ...

What I need to do is split the cell into separate rows, using the comma as a delimiter. I will be reading the cell from another sheet and need a formula that will provide me with

A1: A-dec International Inc.
A2: A. Bellotti
A3: A. DEPPELER S.A.

Many Thanks!

 

[sdewar2]

Hello,

I'd first like to say thank you for everyone who's worked on providing the answer to this question. Its really helped me so far.

I have one more thing to add on to the question though. Is it possible for me to recognize a carriage return (alt-ent) as a delimiter?

For example, the following values are in the same cell, but have been 'separated' by a carriage return as opposed to a space, comma, etc:

Car
Train
Plane

I need to separate these values using the same macro given on the first few pages, but with alt-enter as a delimiter as opposed to " " or " , ".

Any help on the matter would be greatly appreciated.

 

[threearabawys]

Hey guys,

I have a cell that will always generate binary values like so...

00111011000 etc ...

I need to split this cell into separate columns so they would be like this...

A20: 00
A21: 111
A22: 0
A23: 11
A24: 000

Any help would be greatly appreciated...
Thanks in advance...

 

[Rick Rothstein]

Assuming the cell with the binary number is A1, give this macro a try...

Sub SplitBinaryNumbers()
  Dim Bin As Variant
  Bin = Application.Transpose(Split(Replace(Replace(Range("[B][COLOR=#FF0000]A1[/COLOR][/B]").Value, "01", "0,1"), "10", "1,0"), ","))
  With Range("A20").Resize(UBound(Bin))
    .NumberFormat = "@"
    .Cells = Bin
  End With
End Sub

 

[threearabawys]

Assuming the cell with the binary number is A1, give this macro a try...

Sub SplitBinaryNumbers()
  Dim Bin As Variant
  Bin = Application.Transpose(Split(Replace(Replace(Range("[B][COLOR=#FF0000]A1[/COLOR][/B]").Value, "01", "0,1"), "10", "1,0"), ","))
  With Range("A20").Resize(UBound(Bin))
    .NumberFormat = "@"
    .Cells = Bin
  End With
End Sub

Thank you so much, that did it

 

[threearabawys]

I made a function that counts the characters in each of the resulting cells like so...

Is there a way to apply the newly resulting cell values to a stacked bar chart but have the chart alternate between each cell down the column...

IE. set the first cell to the red bar the second to the blue bar, third one to the red bar and keep alternating all the way down the column ?

 

[Rick Rothstein]

I have modified my macro to produce those length for Column A20:A# values in Column B so that the macro does both functions for you. As for the chart question... I am sorry, but I have never had to work with them so I am unsure how to program them. Someone familiar with charts should come along somewhat shortly and respond to that part of your question.

 

[threearabawys]

I have modified my macro to produce those length for Column A20:A# values in Column B so that the macro does both functions for you. As for the chart question... I am sorry, but I have never had to work with them so I am unsure how to program them. Someone familiar with charts should come along somewhat shortly and respond to that part of your question.

I think there's a problem with the forum because I can't find the modified macro, but thank you so much, I would have probably kept hitting my head against the wall for a while trying to figure it out

 

[Rick Rothstein]

I think there's a problem with the forum because I can't find the modified macro, but thank you so much, I would have probably kept hitting my head against the wall for a while trying to figure it out

Heh-heh, no the problem was not with the forum... it was with me... I forgot to copy it into my response. Here is the code that I meant to post...

Sub SplitBinaryNumbers()
  Dim Bin As Variant
  Bin = Application.Transpose(Split(Replace(Replace(Range("A1").Value, "01", "0,1"), "10", "1,0"), ","))
  With Range("A20").Resize(UBound(Bin))
    .NumberFormat = "@"
    .Cells = Bin
    .Resize(UBound(Bin)).Offset(, 1) = Evaluate("IF(LEN(A20:A" & UBound(Bin) & "),LEN(A20:A" & 19 + UBound(Bin) & "),"""")")
  End With
End Sub

 

[kevinruairi]

Hey there,

Thank you to VoG for the code in post #18 in this thread - it has been extremely useful.


I am now having a small difficulty with data that has comma delimited values in two columns.

My first screenshot shows my raw data. (I have colour coded the text to help with my query - the matching colours show the matching data).
As you can see I have comma delimited values in both Column E and Column F.

When I run the VBA code (and 'split' on Column E), I come out with this:

As you can see, the code has nicely stacked the data from Column E into individual rows; but it has taken the cell data from Column F and replicated it.

Ideally what I would like is to 'pair' up the comma delimited values from both Column E and Column F, and then have them display on their own row, with all other column values remaining the same.
So the below screenshot is what I need:

I hope that is clear.
Anyone know if this is possible? It would save me a lot of manual work.

Thanks

 

[Rick Rothstein]

@kevinruairi

Give this macro a try (it is a modification of the code at the link I posted in Message #49)...

Sub RedistributeData()
  Dim X As Long, LastRow As Long, A As Range, Table As Range, Data1() As String, Data2() As String
  Const Delimiter As String = ","
  Const DelimitedColumn1 As String = "E"
  Const DelimitedColumn2 As String = "F"
  Const TableColumns As String = "A:M"
  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
    Data1 = Split(Cells(X, DelimitedColumn1), Delimiter)
    Data2 = Split(Cells(X, DelimitedColumn2), Delimiter)
    If UBound(Data1) > 0 Then
      Intersect(Rows(X + 1), Columns(TableColumns)).Resize(UBound(Data1)).Insert xlShiftDown
    End If
    If Len(Cells(X, DelimitedColumn1)) Then
      Cells(X, DelimitedColumn1).Resize(UBound(Data1) + 1) = WorksheetFunction.Transpose(Data1)
    End If
    If Len(Cells(X, DelimitedColumn2)) Then
      Cells(X, DelimitedColumn2).Resize(UBound(Data2) + 1) = WorksheetFunction.Transpose(Data2)
    End If
  Next
  LastRow = Cells(Rows.Count, DelimitedColumn1).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(DelimitedColumn1).SpecialCells(xlFormulas).Clear
    Table.Value = Table.Value
  End If
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub