Splitting text in cells.

[Saighead]

Hi,

I need a script that would break up a block of text in a cell at full stops, question marks, and exclamation marks, and create additional cells (not rows) shifting bottom cells down and inserting split sentences consecutively into created cells.

So, for example,

A1 Sentence 1. Sentence 2? Sentence 3!
A2 Sentence 4.

Soulld become:

A1 Sentence 1.
A2 Sentence 2?
A3 Sentence 3!
A4 Sentence 4.

Could someone help me with this, please?

Thanks in advance.

 

[Rick Rothstein]

Returned data

A1 Sentence 1
Sentence 2
Sentence 3
A2 Sentence 4
A3 Sentence 1
A3 Sentence 2
A3 Sentence 3
This data to be last

I assumed that each sentence was supposed to go in its own cell, not multiple sentences remaining in the same cell split into different lines. I made this assumption based on this taken from the OP's first message....

"I need a script that would break up a block of text in a cell at full stops, question marks, and exclamation marks, and create additional cells (not rows) shifting bottom cells down and inserting split sentences consecutively into created cells."

 

[nemmi69]

It only moves the cells below down not the entire row (checked this by putting data in the column next to the selection.

Probably needs clarification from @Saighead

 

[Saighead]

@nemmi69

Tried your modified code from Post 20 together with the function from post 13 .
Result: Run-time error '13': Type mismatch. [ Debugger goes here: LbInArray = LBound(InputArray) ]

@Rick Rothstein

Tried your code from post 12 .
Result: Run-time error '13': Type mismatch. [ Debugger goes here: For R = 1 To UBound(Data)]

Cell (A1) I was trying to break up contained "Sentence 1. Sentence 2? Sentence 3!" (without quotes).

As for the argument above, each sentence is supposed to go in its own cell. It shouldn't be a case of multiple sentences remaining in the same cell split into different lines.

PS. I got one working (well, sort of) solution here (post 15 ). Maybe you'll find it useful for your own scripts...
The drawbacks are: a) it's pretty slow when columns are long, b) it inserts a blank cell after last segments for every original cell, and c) it keeps spaces after separators (.?!), so that every new cell starts with a leading space.

PPS. Maybe your scripts are for newer versions of Excel? I'm using Excel 2007...

 

[nemmi69]

Sorry, Found it did not take care of data that has no criteria's in.

Should be fixed now

Function MultiCritSplit(ByVal InString As String, Crit1 As String, Optional Crit2 As String, Optional Crit3 As String, Optional Crit4 As String, Optional Crit5 As String) As String()
Dim TmpString As String
Dim CritArray() As String
Dim OutArray() As String
Dim MidString As String
Dim ArrayCnt As Integer
Dim LenInString As Integer
Dim CharCnt As Integer
Dim ChkLoop As Integer
Dim ArrayID As Integer
Dim RowInc As Integer
Dim CritFnd As Boolean


ArrayCnt = 0


' Validate
If Trim(Crit1) = "" Or Trim(InString) = "" Then
    GoTo NoCrit
Else
    ReDim CritArray(ArrayCnt)
    CritArray(ArrayCnt) = Crit1
End If
 
If IsMissing(Crit2) = False Then
    ArrayCnt = ArrayCnt + 1
    ReDim Preserve CritArray(ArrayCnt)
    CritArray(ArrayCnt) = Crit2
End If


If IsMissing(Crit3) = False Then
    ArrayCnt = ArrayCnt + 1
    ReDim Preserve CritArray(ArrayCnt)
    CritArray(ArrayCnt) = Crit3
End If


If IsMissing(Crit4) = False Then
    ArrayCnt = ArrayCnt + 1
    ReDim Preserve CritArray(ArrayCnt)
    CritArray(ArrayCnt) = Crit4
End If


If IsMissing(Crit5) = False Then
    ArrayCnt = ArrayCnt + 1
    ReDim Preserve CritArray(ArrayCnt)
    CritArray(ArrayCnt) = Crit5
End If


' Split input string
ArrayID = 0
CritFnd = False
TmpString = InString
LenInString = Len(TmpString)
CharCnt = 1
RowInc = 1
Do While LenInString > 0 And RowInc < 10000
    For ChkLoop = 0 To ArrayCnt
        MidString = Mid(TmpString, CharCnt, 1)
        If MidString = CritArray(ChkLoop) Then
            ReDim Preserve OutArray(ArrayID)
            OutArray(ArrayID) = Trim(Mid(TmpString, 1, CharCnt - 1))
            TmpString = Right(TmpString, LenInString - CharCnt)
            LenInString = Len(TmpString)
            ArrayID = ArrayID + 1
            CharCnt = 1
            CritFnd = True
            Exit For
        End If
    Next ChkLoop
    CharCnt = CharCnt + 1
    RowInc = RowInc + 1
Loop
If CritFnd = False Then
    ReDim Preserve OutArray(ArrayID)
    OutArray(ArrayID) = InString
End If
MultiCritSplit = OutArray
Exit Function


NoCrit:


End Function

 

[Saighead]

@nemmi69

Uh, sorry, no... Same error, debugger goes to the same line...

 

[Rick Rothstein]

@Rick Rothstein

Tried your code from post 12 .
Result: Run-time error '13': Type mismatch. [ Debugger goes here: For R = 1 To UBound(Data)]

Cell (A1) I was trying to break up contained "Sentence 1. Sentence 2? Sentence 3!" (without quotes).

I think I know what the problem may have been. Here is my revised code which worked for me when I tested it... see if it also works for you as well.

[table="width: 500"]
[tr]
	[td]Sub SplitSelectedSentenceCellsDown()
  Dim R As Long, Cnt As Long, Combo As String, Sentences As Variant, Result As Variant
  Dim Data As Variant
  Data = Selection.Value
  Cnt = Selection.Rows.Count
  If IsArray(Data) Then
    For R = 1 To UBound(Data)
      Combo = Combo & " " & Data(R, 1)
    Next
  Else
    Combo = Data
  End If
  Combo = Trim(Combo)
  If Not Right(Combo, 1) Like "[.?!]" Then Combo = Combo & "."
  Sentences = Split(Replace(Replace(Replace(Combo, ".", "." & vbLf), "?", "?" & vbLf), "!", "!" & vbLf), vbLf)
  ReDim Result(1 To UBound(Sentences), 1 To 1)
  Selection(1).Resize(UBound(Sentences) - Cnt).Insert xlDown
  For R = 1 To UBound(Sentences)
    Result(R, 1) = Trim(Sentences(R - 1))
  Next
  Selection(1).Resize(UBound(Result)) = Result
End Sub[/td]
[/tr]
[/table]

PPS. Maybe your scripts are for newer versions of Excel? I'm using Excel 2007...

It is always a good idea to mention the earliest version of Excel that will ever be used with your workbook.

 

[Saighead]

@Rick Rothstein
Thank you very much! Everything worked liked a charm. Your script breathed through huge chunks of text in seconds, saved me tons of work.

 

[nemmi69]

@nemmi69

Uh, sorry, no... Same error, debugger goes to the same line...

Bit strange, what version of Excel are you running? I wrote this in 2013

 

[Rick Rothstein]

Bit strange, what version of Excel are you running? I wrote this in 2013

The OP said he was using Excel 2007 at the bottom of Message #23 .