Forum Discussion
Text to columns
As this seems to be a problem many people (including myself) have encountered...
How about executing a VBA procedure (shown below) to split the text? You would not have to save the VBA procedure in the workbook; you could either create it in your PERSONAL.xlsb file, or just store it in the workbook temporarily, and delete the code after use.
Sub SplitTextToColumns()
' This procedure will split the text in a column of the currently-
' selected row into separate adjacent columns in the same row.
' The split occurs where a particular delimiter is found, which
' is specified by the user.
' The procedure splits the text in all rows from the current row down
' until it reaches an empty cell (or a cell with an empty string
' value) in the source-text column. Code is included to warn the
' user if some non-empty string value is about to be overwritten.
Const strPROCEDURE_NAME As String = "SplitTextToColumns"
Dim strWorksheetName As String
'
Dim strMessage As String
Dim in4UserResponse As VbMsgBoxResult
'
Dim strDelimiter As String
Dim strSourceCol As String
'
Dim in4CurrentRow As Long
Dim objRange As Range
Dim strCellContent As String
Dim strPieces() As String
Dim in4PieceIndex As Long
Dim in4RelativeCol As Long
'---- Determine the active worksheet and row.
strWorksheetName = ActiveSheet.Name
in4CurrentRow = ActiveCell.Row
'---- Get confirmation and option choices from the user.
strMessage = "Are you sure you want to split cell contents" _
& " in worksheet " & strWorksheetName _
& ", starting at row " & CStr(in4CurrentRow) _
& " and overwriting adjacent columns to the right?"
in4UserResponse = MsgBox(strMessage, vbQuestion Or vbYesNo _
Or vbDefaultButton2, strPROCEDURE_NAME)
If in4UserResponse = vbNo Then
Exit Sub
End If
' -- Prompt for the column.
strMessage = "Which column contains the text to be split? (Enter" _
& " the letter(s).)"
strSourceCol = InputBox(strMessage, strPROCEDURE_NAME, "A")
If strSourceCol = "" Then
strMessage = "That's required information. Quitting."
Call MsgBox(strMessage, vbInformation Or vbOKOnly, strPROCEDURE_NAME)
Exit Sub
ElseIf Len(strSourceCol) > 3 Then
strMessage = "Invalid input. Quitting."
Call MsgBox(strMessage, vbInformation Or vbOKOnly, strPROCEDURE_NAME)
Exit Sub
ElseIf Len(strSourceCol) = 3 _
And UCase$(strSourceCol) >= "XED" Then
strMessage = "Too far to the right. Quitting."
'...that far out, the text is likely to be split beyond the
' available columns.
Call MsgBox(strMessage, vbInformation Or vbOKOnly, strPROCEDURE_NAME)
Exit Sub
Else
strSourceCol = UCase$(strSourceCol)
End If
' -- Prompt for the delimiter.
strMessage = "Enter the delimiter character, or TAB or LF or CR" _
& " for a special character:"
strDelimiter = InputBox(strMessage, strPROCEDURE_NAME)
If strDelimiter = "" Then
strMessage = "That's required information. Quitting."
Call MsgBox(strMessage, vbInformation Or vbOKOnly, strPROCEDURE_NAME)
Exit Sub
ElseIf UCase$(strDelimiter) = "TAB" Then
strDelimiter = Chr(9) 'tab character
ElseIf UCase$(strDelimiter) = "LF" Then
strDelimiter = Chr(10) 'line feed character
ElseIf UCase$(strDelimiter) = "CR" Then
strDelimiter = Chr(13) 'carriage return character
ElseIf Len(strDelimiter) > 1 Then
strMessage = "Invalid input. Quitting."
Call MsgBox(strMessage, vbInformation Or vbOKOnly, strPROCEDURE_NAME)
Exit Sub
Else
'Use the value in strDelimiter as-is.
End If
'---- Process the current row and following rows.
With Worksheets(strWorksheetName)
Do
Set objRange = .Range(strSourceCol & CStr(in4CurrentRow))
objRange.Select
'
strCellContent = Selection.Value
If strCellContent = "" Then
'...we're done.
strMessage = "Stopping at 'empty' cell in row " _
& CStr(in4CurrentRow)
Call MsgBox(strMessage, vbInformation Or vbOKOnly)
Exit Do
End If
' -- Do the work for this row.
strPieces = Split(strCellContent, strDelimiter)
For in4PieceIndex = 0 To UBound(strPieces)
in4RelativeCol = in4PieceIndex + 1
strCellContent = objRange.Offset(0, in4RelativeCol).Value
If strCellContent <> "" Then
strMessage = "WARNING! Row " & CStr(in4CurrentRow) _
& " is not empty in a destination cell. Is It" _
& " OK to overwrite the contents of this row?"
in4UserResponse = MsgBox(strMessage _
, vbExclamation Or vbYesNoCancel Or vbDefaultButton2 _
, strPROCEDURE_NAME)
If in4UserResponse = vbNo Then
GoTo NextRow
ElseIf in4UserResponse = vbCancel Then
Exit Do
Else
'...continue with the user's permission.
End If
End If
objRange.Offset(0, in4RelativeCol).Value = _
strPieces(in4PieceIndex)
Next in4PieceIndex
NextRow:
' -- Advance a row.
in4CurrentRow = in4CurrentRow + 1
Application.Goto Reference:="R" & CStr(in4CurrentRow) _
& "C1"
DoEvents
Loop
End With
End Sub
If you find that your invisible delimiter is not a line feed character (LF) or a carriage return character (CR), you can add code following the comment "Prompt for the delimiter" to handle a different delimiter.
2023-03 addendum: Before/during September 2022 (shortly before I posted this solution), Microsoft added the built-in function TEXTSPLIT to the latest versions of Excel. TEXTSPLIT also supports the use of multiple delimiters in one pass. So while the VBA code above is still usable (and of course, can be customized for special circumstances), the use of TEXTSPLIT might be a better, quicker choice.
- macwombatJul 21, 2023Copper Contributor
SnowMan55 oh wow!!!! Thank you so much. I tried using the TEXTSPLIT and couldn't get it to work, but your VBA procedure worked a treat! I had never used Visual Basic in a spreadsheet before, but it was pretty easy to do with your code. Thank you, thank you, thank you. There were fist pumps in the air when it worked!!
- SergeiBaklanJul 21, 2023Diamond Contributor
Why don't combination of TEXTJOIN/TEXTSPLIT doesn't work?
- SarahD33Oct 20, 2022Copper ContributorUm, this is amazing and it worked with the CR!
To reply to dscheikey, I was using Ctrl J in the Find and Replace function to (I guess hopefully) get rid of all of the carriage returns, but obviously it didn't work.
This is the very first time I've posted somewhere and gotten an answer that worked. Thank you x 1,000,000 SnowMan55!