rearrange text in cell (more complex than a first name surname switch!)

[barley18]

Hello,

I would love your help with this. I have a column of cells with text which always takes the following form:

aaaaaaaaa - bbbbbbbb, cccccccccc, dddddddddd, eeeeeeeeeee, ffffffffffffffff, etc

Is there a formula I could use in another column to reorder this data into the following:

bbbbbbbbb
aaaaaaaaa
cccccccccc
dddddddd
eeeeeeeee
fffffffffffffff

I'd like the data on different lines as above but within one cell. The commas and hyphen are always in the same place. It's crucial that the text which comes immediately after the hyphen but before the first comma becomes the first line, and that the text before the hyphen becomes the second line. Everything after that can remain in sequence, just on separate lines.

Hope this makes sense! Huge thanks in advance.

 

[Rick Rothstein]

Here is another formula solution that you can consider...

=SUBSTITUTE(MID(REPLACE(A1,FIND(",",A1),0,", "&LEFT(A1,FIND("-",A1)-2)),FIND("-",A1)+2,LEN(A1)),", ",CHAR(10))

However, if you want a VBA macro solution, give this one a try...

[table="width: 500"]
[tr]
	[td]Sub barley18()
  Dim Arr As Variant, Cell As Range
  Application.ScreenUpdating = False
  For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
    Arr = Split(Replace(Replace(Cell.Value, " ", ""), "-", ","), ",")
    Cell.Offset(, 1) = Join(Application.Index(Arr, 1, Split("2 1 " & Join(Application.Transpose(Evaluate("ROW(3:" & UBound(Arr) + 1 & ")"))))), vbLf)
  Next
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[mohadin]

Hi so it is in one cell HUmmm

Sub test()
    Dim sm As Object, a
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For rw = 1 To lr
        With CreateObject("VBScript.RegExp")
            .Global = True
            .Pattern = "(\w+)"
            Set m = .Execute(Range("a" & rw))
            ReDim a(1 To m.Count)
            For i = 0 To m.Count - 1
                Set sm = m(i)
                a(i + 1) = sm
            Next
            tm = a(1): a(1) = a(2): a(2) = tm
            res = Join(a, Chr(10))
            Range("b" & rw) = res
        End With
    Next
End Sub

Or

Sub test2()
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    Dim b As Variant
    ReDim b(1 To 1)
    For i = 1 To lr
        a = Split(Join(Split(Range("a" & i), " -"), ","), ",")
       tm = a(1): a(1) = a(2): a(2) = tm
       tm = Join(a, Chr(10))
   Range("b" & i) = tm
    Next

End Sub

 

[Rick Rothstein]

However, if you want a VBA macro solution, give this one a try...

Actually, I had a perfectly good formula in Message #10 which could be used as the basis for a non-looping macro...

Sub barley18()
  Dim Addr As String
  Addr = "A1:A" & Cells(Rows.Count, "A").End(xlUp).Row
  Range(Addr).Offset(, 1) = Evaluate(Replace("IF({1},SUBSTITUTE(MID(REPLACE(@,FIND("","",@),0,"", ""&LEFT(@,FIND(""-"",@)-2)),FIND(""-"",@)+2,LEN(@)),"", "",CHAR(10)))", "@", Addr))
End Sub