none
Possible to use Range.TextToColumns and sort output into columns based on substring? RRS feed

  • Question

  • I have a column of data I'd like to sort into separate columns using the pipe character as a delimiter.  However, I'd like to sort the results into columns dependent upon certain substrings. For example, if I have this as my source column (let's call it col A):

    Name foobardog | Age 99 | HeightInches 80 | Weight 120
    Age 15 | Name bardogfoo | Weight 30
    Weight 200
    HeightInches 400 | Age 12 | Name foodogbar

    I would like to be able to use conditional logic with Range.TextToColumns to sort Name into column A, Age into B, HeightInches into C, and Weight into D.  How would I go about this?

    Wednesday, May 27, 2015 4:06 PM

Answers

  • TextToColumns doesn't provide a way to sort columns. Here is a macro that may do what you want:

    Sub SplitData()
        Const FirstRow = 1 ' change if needed
        Dim CurRow As Long
        Dim LastRow As Long
        Dim arrParts() As String
        Dim i As Long
        Dim strPart As String
        Application.ScreenUpdating = False
        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        For CurRow = FirstRow To LastRow
            arrParts = Split(Cells(CurRow, 1).Value, "|")
            Cells(CurRow, 1).ClearContents
            For i = 0 To UBound(arrParts)
                strPart = Trim(arrParts(i))
                Select Case LCase(Left(strPart, 3))
                    Case "nam"
                        Cells(CurRow, 1).Value = Mid(strPart, 6)
                    Case "age"
                        Cells(CurRow, 2).Value = Mid(strPart, 5)
                    Case "hei"
                        Cells(CurRow, 3).Value = Mid(strPart, 14)
                    Case "wei"
                        Cells(CurRow, 4).Value = Mid(strPart, 8)
                End Select
            Next i
        Next CurRow
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by awyeahbuddy Wednesday, May 27, 2015 9:05 PM
    Wednesday, May 27, 2015 4:24 PM

All replies

  • TextToColumns doesn't provide a way to sort columns. Here is a macro that may do what you want:

    Sub SplitData()
        Const FirstRow = 1 ' change if needed
        Dim CurRow As Long
        Dim LastRow As Long
        Dim arrParts() As String
        Dim i As Long
        Dim strPart As String
        Application.ScreenUpdating = False
        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        For CurRow = FirstRow To LastRow
            arrParts = Split(Cells(CurRow, 1).Value, "|")
            Cells(CurRow, 1).ClearContents
            For i = 0 To UBound(arrParts)
                strPart = Trim(arrParts(i))
                Select Case LCase(Left(strPart, 3))
                    Case "nam"
                        Cells(CurRow, 1).Value = Mid(strPart, 6)
                    Case "age"
                        Cells(CurRow, 2).Value = Mid(strPart, 5)
                    Case "hei"
                        Cells(CurRow, 3).Value = Mid(strPart, 14)
                    Case "wei"
                        Cells(CurRow, 4).Value = Mid(strPart, 8)
                End Select
            Next i
        Next CurRow
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by awyeahbuddy Wednesday, May 27, 2015 9:05 PM
    Wednesday, May 27, 2015 4:24 PM
  • Woo!  I made the necessary tweaks and it worked like a dream.  Thanks Hans!
    Wednesday, May 27, 2015 9:05 PM
  • TextToColumns doesn't provide a way to sort columns. Here is a macro that may do what you want:

    (code)



    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Hey Hans! It's been a few days but I was wondering if this might be a faster solution--rather than selecting the case and writing the value of each cell, it stores in an array and then writes it all in one go at the end.

    Since I'm working with a dataset of 40K+ rows, I'm trying to optimize this any way I possibly can.  Any input would be appreciated!

        Const FIRSTROW = 2
        Dim curRow As Long
        Dim lastRow As Long
        Dim i As Long
        Dim strPart As String
        Dim arrParts() As String
        Dim tempArray() As String
        Dim rfrRange As Range
    
        lastRow = Range("O" & Rows.Count).End(xlUp).Row
        ReDim tempArray(FIRSTROW To lastRow, 15 To 18)
        Set rfrRange = Range(Cells(FIRSTROW, 15), Cells(lastRow, 18))
    
        For curRow = FIRSTROW To lastRow
            arrParts = Split(Cells(curRow, 15).Value, "|")
            Cells(curRow, 15).ClearContents
            For i = 0 To UBound(arrParts)
                strPart = Trim(arrParts(i))
                Select Case LCase(Left(strPart, 13))
                    Case "similar ip ad"
                        tempArray(curRow, 15) = strPart
                    Case "similar phone"
                        tempArray(curRow, 16) = strPart
                    Case "similar email"
                        tempArray(curRow, 17) = strPart
                    Case "similar addre"
                        tempArray(curRow, 18) = strPart
                End Select
            Next i
        Next curRow
        
        rfrRange.Value = tempArray






    Tuesday, June 9, 2015 3:33 PM
  • It might well be faster - the best way to find out is to try it!

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, June 12, 2015 3:40 PM