String splitter for as long as there is something in the cell

excel, excel-2007, vba

Solution

Something like this:

get the row number of the last populated row in column A. (Replace with the column of your choice). Then use that row number in the for-loop, but start with 1, not with zero. Remove the debug.print if no longer required.

Sub SplitToColumns()
Dim rowCount As Long
rowCount = Cells(rows.Count, "A").End(xlUp).Row
Debug.Print rowCount

    Range("A1").Select
    For Counter = 1 To rowCount Step 1

        Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
            Tab:=False, Semicolon:=False, Comma:=True, Space:=False, _
            Other:=False, _
            FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
            TrailingMinusNumbers:=True
        ActiveCell.Offset(1, 0).Select
    Next Counter
End Sub

There are several other ways to make this code more efficient. For example, you don't need to select the cell before you do a TextToColumns. In fact, you can do a TextToColumns on a range of cells, you don't need to loop through all the cells in the range.

Use the technique above to get the row number of the last row, and then build a range starting in A1 and extending to column A, last populated row number.

Then perform a TextToColumns on the whole range, all in one go. Much, much faster than looping!!!

Sub SplitToColumns()
    Dim rowCount As Long
    Dim ws As Worksheet

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        rowCount = .Cells(.Rows.Count, "A").End(xlUp).Row

        .Range("A1:A" & rowCount).TextToColumns _
            Destination:=.Range("A1"), _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=False, _
            Semicolon:=False, _
            Comma:=True, _
            Space:=False, _
            Other:=False, _
            FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
            TrailingMinusNumbers:=True
    End With
End Sub

Problem

Original source