Loop to split text based on vbCrLf

Brutusar

Board Regular
Joined
Nov 23, 2019
Messages
125
Office Version
  1. 365
Platform
  1. Windows
Hi, I have written a code that should loop thru a column and if there is a cell with carriage return, it should split the text so the last row of text in the cell is moved to the next column, and the remaining text should be in one row.

Example:

The cell in row 1 should be like row 2.

Car make
Volvo
Car makeVolvo


The code I have written is:

VBA Code:
Sub SplitText()

    Dim cell As Range
    Dim str() As String

    For Each cell In Range("G1:G215")
        
            str = VBA.Split(ActiveCell.Value, vbCrLf)
        
            ActiveCell.Resize(1, UBound(str) + 1).Offset(0, 1) = str
       
    Next cell

End Sub

This code will move all text in the cell to the next column, so it is not very useful.

Any thoughts on what I am missing here?
 

VBasic2008

Board Regular
Joined
Oct 25, 2016
Messages
89
Office Version
  1. 2019
Platform
  1. Windows
Split Cell Values to Rows

There are a few mistakes:
The line separator is most often (maybe always) vbLf, not vbCrLf, so the 'split' returns the same value.
You are writing to the next cell (.Offset(0, 1)) instead of the same cell (no offset).
You are not activating or selecting any cell, so each result will be written to the same cell which is to the right of whichever cell is active (215 times).

VBA Code:
Option Explicit

Sub SplitCellValues()

    Const srgAddress As String = "G1:G10000"
    Const Delimiter As String = vbLf
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim srg As Range: Set srg = ws.Range(srgAddress)
    
    Dim sCell As Range ' Current Cell
    Dim sValue As Variant ' Current Value (we don't know what it is)
    Dim SubStrings() As String ' Current Substrings Array
    Dim UB As Long ' Current Substrings Array's Upper Limit
    Dim SplitCount As Long ' Number of Split Cells (Statistics)

    Application.ScreenUpdating = False
    
    For Each sCell In srg.Cells
        sValue = sCell.Value
        If Not IsError(sValue) Then ' skip if error value
            SubStrings = Split(CStr(sCell), Delimiter)
            ' 'UBound(SubStrings)' will return '- 1' if the string is
            ' an empty string (""), and '0' if no delimiter is found.
            If UBound(SubStrings) > 0 Then
                sCell.Resize(, UBound(SubStrings) + 1).Value = SubStrings
                SplitCount = SplitCount + 1
            End If
        End If
    Next sCell

    srg.EntireRow.AutoFit

    Application.ScreenUpdating = True

    MsgBox SplitCount & " cell values split.", vbInformation, "SplitCellValues"

End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
38,059
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Or if you are just trying to remove everything after the 1st line feed

If this is all the OP wants to do, then no looping is needed...
VBA Code:
Sub SplitText()
  Range("G1:G215").Replace vbLf & "*", "", xlPart, , , , False
  Range("G1:G215").Rows.AutoFit
End Sub
Note: The last line of code duplicates the autofitting of rows that your code does automatically.
 
Last edited:

JEC

Well-known Member
Joined
Aug 21, 2021
Messages
1,075
Office Version
  1. 365
Platform
  1. Windows

Forum statistics

Threads
1,182,145
Messages
5,933,889
Members
436,916
Latest member
LonN90

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top