Text to columns , using any letter

[hcabs99]

HI

I have a file to import, which contains a number of columns, one of which is a text field containing a varying number of words and field length. Is there a way via Text to columns functionality or via VBA where i can look for the end of the text and put the break in there?

Example below : The items in the quotations are the area i need to split out (sadly no quotations in the source file!) The text field will always end in a letter.


C001 19083 "First Word1 Secondword2 thirdword forthword4A" F 555.000 332.000 223.000 CSE

If it helps.. The next field after the text will always be an F , X or an S

Hope this makes sense. Appreciate any advise on this

Cheers

 

[hcabs99]

I am sure that someone can probably come up with shorter or more efficient code, but this should work. If all your data is in column A, it will do a Text to Columns on column A in the manner that you want:

Sub MySplitData()

    Dim lRow As Long
    Dim r As Long
    Dim myString As String
    Dim ln As Long
    Dim i As Long
    Dim s As Long
    Dim temp As String

    Application.ScreenUpdating = False

'   Find last row of data in column A
    lRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows starting with row 1
    For r = 1 To lRow
'       Initial space counter to 0
        s = 0
'       Capture entry in column A
        myString = Cells(r, "A")
        ln = Len(myString)
'       Find second space
        For i = 1 To ln
'           Increment space counter
            If Mid(myString, i, 1) = " " Then
                s = s + 1
            End If
'           When second space, insert double-quote
            If s = 2 Then
                myString = Left(myString, i) & Chr(34) & Mid(myString, i + 1)
                Exit For
            End If
        Next i
'       Insert second double-quote
        temp = myString & " F S X "
        temp = Replace(temp, " F ", Chr(34) & " F ")
        temp = Replace(temp, " S ", Chr(34) & " S ")
        temp = Replace(temp, " X ", Chr(34) & " X ")
        myString = Left(temp, ln + 2)
        Cells(r, "A") = myString
    Next r
    
'   Do text to columns on data
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1)), _
        TrailingMinusNumbers:=True
          
    Application.ScreenUpdating = True
    
End Sub

Spot on !!! Many thanks .. really appreciate your patience and efforts here ! Works a treat ! Thanks to all that helped

 

[Joe4]

You are welcome!