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.

 

[JoeMo]

Here's a macro you can try.

Sub barley18()
'change range R to suit your layout
Dim R As Range, c As Range, Vin As Variant, i As Long, ct As Long, Vout As Variant
Set R = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Application.ScreenUpdating = False
R.Replace "-", ","
For Each c In R
    ct = 0
    Vin = Split(c.Value, ",")
    ReDim Vout(0 To UBound(Vin))
    For i = LBound(Vin) To UBound(Vin)
        If i = 0 Then
            Vout(ct) = Vin(i + 1)
            ct = ct + 1
            Vout(ct) = Vin(i)
        ElseIf i = 1 Then
            GoTo Nx
        Else
            ct = ct + 1
            Vout(ct) = Vin(i)
        End If
Nx: Next i
    With c
        .Value = Join(Vout, Chr(10))
        .WrapText = True
    End With
    Erase Vout
Next c
R.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

 

[Gerald Higgins]

Or as a formula . . .

=MID(A1,FIND("-",A1)+2,FIND(",",A1)-(FIND("-",A1)+2))&" "&LEFT(A1,FIND("-",A1)-2)&SUBSTITUTE(MID(A1,FIND(",",A1),1000),",","")

To get this to break into different lines, you can either just format the cell to add Text Wrapping, OR you can introduce characters to force the line breaks, like this

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

 

[barley18]

Thanks so much for this, Joe. It doesn't seem to like the line:

Vout(ct) = Vin(i + 1)

Unfortunately I'm nowhere near understanding this bit so can't work out what the problem might be.

Really appreciate the suggestion though, thank you

 

[JoeMo]

Thanks so much for this, Joe. It doesn't seem to like the line:

Vout(ct) = Vin(i + 1)

Unfortunately I'm nowhere near understanding this bit so can't work out what the problem might be.

Really appreciate the suggestion though, thank you

What exactly happens when you run the code? If the line:
Vout(ct) = Vin(i + 1)
causes an error, what's the error number and message you get?
Does your data start in cell A1 and go down col A?

 

[barley18]

What exactly happens when you run the code? If the line:
Vout(ct) = Vin(i + 1)
causes an error, what's the error number and message you get?
Does your data start in cell A1 and go down col A?

I get "Run-time error 9. Subscript out of range". There is data in column A but the data I want this to apply to is from B3 down to B32 (or sometimes beyond). So I did change the third line to:

Set R = Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row)

...but still the same error.

 

[JoeMo]

I get "Run-time error 9. Subscript out of range". There is data in column A but the data I want this to apply to is from B3 down to B32 (or sometimes beyond). So I did change the third line to:

Set R = Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row)

...but still the same error.

What are the values of ct and i when you get the error? Can you post the data in B3:B32 in a form that can be copied from a browser and pasted to Excel? See this link for tools to assist you in doing that:
https://www.mrexcel.com/forum/about-board/508133-attachments.html

 

[jolivanes]

In Joe's code try changing this

R.Replace "-", ","

to this

R.Replace " -", ","

 

[mohadin]

Hi
Try this method:

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
            x = m.Count + x
            br = Cells(Rows.Count, 2).End(xlUp).Row
            Range("b" & br + 1).Resize(UBound(a)) = Application.Transpose(a)
        End With
    Next
End Sub

 

[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))