Page 1 of 3 123 LastLast
Results 1 to 10 of 29

Thread: Splitting text in cells.

  1. #1
    New Member
    Join Date
    May 2013
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Splitting text in cells.

    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.
    Last edited by Saighead; Jun 26th, 2018 at 05:24 AM.

  2. #2
    Board Regular nemmi69's Avatar
    Join Date
    Mar 2012
    Posts
    287
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Splitting text in cells.


  3. #3
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,022
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    6 Thread(s)

    Default Re: Splitting text in cells.

    Try this for results starting "C1"
    Code:
    Sub MG26Jun16
    Dim Rng As Range, Dn As Range, sp As Variant, c As Long, P As Long, n As Long
    Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    ReDim Ray(1 To Rng.Count * 10)
    For Each Dn In Rng
        P = 1
        For n = 1 To Len(Dn.Value)
            Select Case Mid(Dn.Value, n, 1)
                Case ".": c = c + 1: Ray(c) = Mid(Dn.Value, P, n - P + 1): P = n + 2
                Case "?": c = c + 1: Ray(c) = Mid(Dn.Value, P, n - P + 1): P = n + 2
                Case "!": c = c + 1: Ray(c) = Mid(Dn.Value, P, n - P + 1): P = n + 2
            End Select
        Next n
    Next Dn
    Range("C1").Resize(c).Value = Application.Transpose(Ray)
    End Sub
    Regards Mick

  4. #4
    New Member
    Join Date
    May 2013
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Splitting text in cells.

    Thanks for the effort but this code does only a small portion of what I need (see my original example). I need split sentences to stay in the same column (with the first segment remaining in the original cell), additional cells created, existing cells shifted down, the whole shebang...

  5. #5
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,022
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    6 Thread(s)

    Default Re: Splitting text in cells.

    If you are referring to My code !!!, then , by changing the results cell (at bottom of code) "C1" to "A1", and based on your data you hold get what you want

  6. #6
    New Member
    Join Date
    May 2013
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Splitting text in cells.

    Quote Originally Posted by MickG View Post
    If you are referring to My code !!!, then , by changing the results cell (at bottom of code) "C1" to "A1", and based on your data you hold get what you want
    You're right, that did it. Could you modify the code so that it's not hardwired to A1 but works on any cell that has focus?

  7. #7
    Board Regular nemmi69's Avatar
    Join Date
    Mar 2012
    Posts
    287
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Splitting text in cells.

    The sub reads from A!

    Code:
    Function MultiCritSplit(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 x As Integer
    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
    TmpString = InString
    LenInString = Len(TmpString)
    CharCnt = 1
    x = 1
    Do While LenInString > 0 And x < 10000
        For ChkLoop = 0 To ArrayCnt
            MidString = Mid(TmpString, CharCnt, 1)
            If MidString = CritArray(ChkLoop) Then
                ReDim Preserve OutArray(ArrayID)
                OutArray(ArrayID) = Mid(TmpString, 1, CharCnt - 1)
                TmpString = Right(TmpString, LenInString - CharCnt)
                LenInString = Len(TmpString)
                ArrayID = ArrayID + 1
                CharCnt = 1
                Exit For
            End If
        Next ChkLoop
        CharCnt = CharCnt + 1
        x = x + 1
    Loop
    
    
    MultiCritSplit = OutArray
    Exit Function
    
    
    NoCrit:
    
    
    End Function
    
    
    
    
    Sub TestSplit()
    Dim RplyArray() As String
    Dim LbRArray As Integer
    Dim UbRArray As Integer
    Dim Rloop As Integer
    
    
    
    
    RplyArray = MultiCritSplit(Range("A1").Value, ",", "?", ".", ";", "!")
    LbRArray = LBound(RplyArray)
    UbRArray = UBound(RplyArray)
    
    
    For Rloop = LbRArray To UbRArray
        Range("A" & 3 + Rloop).Value = RplyArray(Rloop)
    Next Rloop
    
    
    End Sub

  8. #8
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,022
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    6 Thread(s)

    Default Re: Splitting text in cells.

    Try this:-
    NB:- The code now Requires yo to select a range of cells.
    Code:
    Sub MG26Jun31
    Dim Rng As Range, Dn As Range, Sp As Variant, c As Long, P As Long, n As Long
    Set Rng = Selection
    For Each Dn In Rng
    Next Dn
    ReDim Ray(1 To Rng.Count * 10)
    For Each Dn In Rng
        P = 1
        For n = 1 To Len(Dn.Value)
            Select Case Mid(Dn.Value, n, 1)
                Case ".": c = c + 1: Ray(c) = Mid(Dn.Value, P, n - P + 1): P = n + 2
                Case "?": c = c + 1: Ray(c) = Mid(Dn.Value, P, n - P + 1): P = n + 2
                Case "!": c = c + 1: Ray(c) = Mid(Dn.Value, P, n - P + 1): P = n + 2
            End Select
        Next n
    Next Dn
    Rng(1).Resize(c).Value = Application.Transpose(Ray)
    End Sub
    Regards Mick

  9. #9
    New Member
    Join Date
    May 2013
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Splitting text in cells.

    MickG

    This modified code overwrites cells below.

    Your initial code loses segments after the last separator (if A1 has "Sentence 1. Sentence 2? Sentence 3! Sentence 4 (no punctuation here)", then Sentence 4 is lost). Also it overwrites cells below instead of shifting them down if they do not end in a separator (.?!), and splits them at separators even when they are not in focus (again losing segments after the last separator)...
    Last edited by Saighead; Jun 26th, 2018 at 09:28 AM.

  10. #10
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    15,203
    Post Thanks / Like
    Mentioned
    272 Post(s)
    Tagged
    21 Thread(s)

    Default Re: Splitting text in cells.

    Cross post https://www.excelforum.com/excel-pro...-in-cells.html

    While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
    This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 2003 & 2013 on Win 7

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •