Macro to separate data

**MyBabyO** · 03-10-2010, 12:44 PM

I'm looking for a macro that can take data that is in one cell with hard returns between the fields and separate it into columns. I need like data in the same columns. For example, my cells might look like this:

"EXISTING INFO
Route 11
BFO576(R)
3.6 kft"

I need 4 columns from this data, but the next cell might only have 3 pieces of that information, but I need all of the "ROUTE" data in one column, all of the "BFO" data in a column and all of the "kft" in one column so that I can sort by any piece of that puzzle.

How could I do this if all cells don't contain all 4 pieces of the puzzle?

Many thanks in advance!

**shg** · 03-10-2010, 01:07 PM

Welcome to the forum.

Post a workbook with some examples of the data.

**MyBabyO** · 03-10-2010, 02:06 PM

Here is a workbook example. Thanks so much!

**shg** · 03-10-2010, 02:17 PM

Try this:

Code:

Sub x()
    Dim cell As Range
    
    Columns("A:A").TextToColumns _
            Destination:=Range("A1"), _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=False, _
            Semicolon:=False, _
            Comma:=False, _
            Space:=False, _
            Other:=True, _
            OtherChar:=vbLf
    
    For Each cell In Intersect(ActiveSheet.UsedRange, Range("A:C"))
        If cell.Text Like "*kft" And cell.Column <> 4 Then
            Cells(cell.Row, 4) = cell.Value
            cell.ClearContents
        ElseIf cell.Text Like "BFO*" And cell.Column <> 3 Then
            Cells(cell.Row, 3) = cell.Value
            cell.ClearContents
        ElseIf cell.Text Like "Route*" And cell.Column <> 2 Then
            Cells(cell.Row, 2) = cell.Value
            cell.ClearContents
        End If
    Next cell
End Sub