Split text from one cell into columns

[oaky72]

Hello,

I have a lot of text in 1 cell that i need to split and move to other columns on the same row.

Using the example below, i need to take any text after the : and place it into separate columns. so NATHAN would be in 1 column, Age 6 in the next etc etc. Any help would be great. Thanks. Kevin

Childs Name/s: NATHAN Age: Age 6 Date of Party: 21st January 2017 Party Venue Address : JDR Karting - Gloucester, Unit 5, Madleaze Industrial Estate, Bristol Road, Gloucester GL1 5SG Start Time : 16.05 End Time : 18.00 RSVP Contact & by date: 077143333 (Sophie) Extra Comments (Max 15 words): Dress comfortably and warmly. The karts are suitable for children between 4-7 years old. How did you find us?: Google Would you like a proof? (Important): Yes. Email a proof copy to approve.

<colgroup><col></colgroup><tbody>
</tbody>

 

[oaky72]

Quote Originally Posted by Rick Rothstein View Post
If you make it one line, the formula I posted will work (copy it across)... if it has to remain two lines, then I see what may be an unresolvable problem... if the text for that item can be short enough to fit all on one line in some cases, but long enough to require two lines in other cases, then I do not immediately see how a formula will be able to account for that variation.

Actually when i have looked at the worksheet the Module did work. The full address which looks like it was on 2 lines was shown in the new column in full.

I tested this on 4 rows of similar data and it looks to have failed on row 2. The difference with the Row 2 data is that it has 8 parts of data whereas row 1 (example text i provided) has 9 parts.

This is the row 2 data

Who's party is it?: Ruth's
Party Venue Address : 63 Tandragee Rd
Gilford
Craigavon
Co.Armagh
BT636HP
Date of Party: 4th March 2017
Start Time : 8pm
RSVP Contact & by date: Ruth: 0754444
Add Photo (optional): 2989113989175467016447332n.jpg.59b83d06b8f1437d441db6abb440a832
Extra Comments (Max 15 words): Don't worry about presents, I would prefer you donated money to Diabetes UK. (a box will be sitting on the night)
How did you find us?: Google

 

[Eric W]

This version keeps track of the headings, and puts the data in the appropriate column. It assumes the data starts on row 1, and it will add a new row above that for the headings when it's done. I don't claim that it's bulletproof, but it should be better.

Sub SplitRecs()
Dim r As Long, x As Variant, y As Variant, i As Long, j As Long
Dim MyData() As Variant, MaxJ As Long, MaxRow As Long
    
    MaxRow = Cells(Rows.Count, "A").End(xlUp).Row
    ReDim MyData(1 To MaxRow + 1, 1 To 100)
    
    MaxJ = 0
    Rows(1).Insert
    For r = 2 To MaxRow + 1
        x = Split(Cells(r, "A"), Chr(10))
        For i = 0 To UBound(x)
            If i < UBound(x) Then
                If InStr(x(i + 1), ":") = 0 Then
                    x(i + 1) = x(i) & Chr(10) & x(i + 1)
                    x(i) = ""
                End If
            End If
            If x(i) <> "" Then
                If InStr(x(i), ":") = 0 Then x(i) = "Misc:" & x(i)
                y = Split(x(i), ":")
                For j = 1 To 100
                    If MyData(1, j) = Trim(y(0)) Or MyData(1, j) = "" Then
                        MyData(1, j) = Trim(y(0))
                        MyData(r, j) = "'" & y(1)
                        If j > MaxJ Then MaxJ = j
                        Exit For
                    End If
                Next j
            End If
        Next i
    Next r
    
    ReDim Preserve MyData(1 To MaxRow + 1, 1 To MaxJ)
    Range(Cells(1, "B"), Cells(MaxRow + 1, MaxJ + 1)).Value = MyData
        
End Sub

One thing I noticed is that the headings are not consistent. In your two examples you have "Childs Name/s" and "Who's party is it?". I suspect you'd want those to be the same, but I have no programmatic way of knowing to combine those. You'll need to clean up the data.

Let me know if this helps.

 

[oaky72]

Thanks Eric. Will take a look in the morning and let you know.

 

[oaky72]

This version keeps track of the headings, and puts the data in the appropriate column. It assumes the data starts on row 1, and it will add a new row above that for the headings when it's done. I don't claim that it's bulletproof, but it should be better.

Sub SplitRecs()
Dim r As Long, x As Variant, y As Variant, i As Long, j As Long
Dim MyData() As Variant, MaxJ As Long, MaxRow As Long
    
    MaxRow = Cells(Rows.Count, "A").End(xlUp).Row
    ReDim MyData(1 To MaxRow + 1, 1 To 100)
    
    MaxJ = 0
    Rows(1).Insert
    For r = 2 To MaxRow + 1
        x = Split(Cells(r, "A"), Chr(10))
        For i = 0 To UBound(x)
            If i < UBound(x) Then
                If InStr(x(i + 1), ":") = 0 Then
                    x(i + 1) = x(i) & Chr(10) & x(i + 1)
                    x(i) = ""
                End If
            End If
            If x(i) <> "" Then
                If InStr(x(i), ":") = 0 Then x(i) = "Misc:" & x(i)
                y = Split(x(i), ":")
                For j = 1 To 100
                    If MyData(1, j) = Trim(y(0)) Or MyData(1, j) = "" Then
                        MyData(1, j) = Trim(y(0))
                        MyData(r, j) = "'" & y(1)
                        If j > MaxJ Then MaxJ = j
                        Exit For
                    End If
                Next j
            End If
        Next i
    Next r
    
    ReDim Preserve MyData(1 To MaxRow + 1, 1 To MaxJ)
    Range(Cells(1, "B"), Cells(MaxRow + 1, MaxJ + 1)).Value = MyData
        
End Sub

One thing I noticed is that the headings are not consistent. In your two examples you have "Childs Name/s" and "Who's party is it?". I suspect you'd want those to be the same, but I have no programmatic way of knowing to combine those. You'll need to clean up the data.

Let me know if this helps.

Hi Eric,

I am getting a compile error , expected end sub

then in yellow it highlights Sub SplitRecs()

Regards.

Kevin

 

[Eric W]

Did you copy the entire macro? It's long enough so that the code box requires a scroll bar. There are about 5 lines (on my PC) that don't show unless you scroll down, including the End Sub line.

 

[Rick Rothstein]

Hi Eric,

I am getting a compile error , expected end sub

then in yellow it highlights Sub SplitRecs()

That means you did not copy all of the code Eric posted. Look back at the code he posted and you will see a vertical scroll bar on the right side of the code window... if you scroll it down, you will see other code and the End Sub which you apparently did not copy. You should be able to click at the beginning of the code, then shift-click-drag downward and when you reach the bottom of the window, it should automatically scroll to the end... when it does, release the shift key and mouse button and all the text should remain selected. Copy/paste that selection into your Excel module.

 

[oaky72]

Did you copy the entire macro? It's long enough so that the code box requires a scroll bar. There are about 5 lines (on my PC) that don't show unless you scroll down, including the End Sub line.

Yes i did not copy all the code. That worked great thanks. Just one issue i have with the column named "Party Venue Address"

See below 3 example recordes

This data taken from my website as a text area rather than a text field. So some of my customers will press enter to a new line but others will type the address without pressing enter. (i presume). Is it possible so the text in this column is on 1 line (like sample 3 below) and not separate lines?

Thanks again.
Kevin

Party Venue Address

The Clarendon Coventry Rd, Hinckley LE10 0JU

Berryfields community Suite Berryfields Primary School John Fitzjohn Avenue HP18 0PS

Thorpe Marriott Village Hall, The Square, Thorpe Marriott, NR8 6XE

<colgroup><col></colgroup><tbody>
</tbody>

 

[Eric W]

Sure. Just look for this line:

x(i + 1) = x(i) & Chr(10) & x(i + 1)

and change it to:

x(i + 1) = x(i) & "[COLOR=#ff0000],[/COLOR] " & x(i + 1)

Change the comma to a space, or a different separator if you want.

 

[oaky72]

Sure. Just look for this line:

x(i + 1) = x(i) & Chr(10) & x(i + 1)

and change it to:

x(i + 1) = x(i) & "[COLOR=#ff0000],[/COLOR] " & x(i + 1)

Change the comma to a space, or a different separator if you want.

Excellent.

Thanks for all your help.

 

[Eric W]

You're welcome. Have a great weekend.