How Do I break up a paragraph in a cell into newline-delimited sentences in the same cell?

[rmlowrie]

Hello all! Well, here is my opportunity to learn from you all!

I have a column that is used by another group to enter notes. Each note they enter on a row of data is separated from the previous data by a date in the "MM/DD/YYYY" format. but they are all in "paragraph" form.

what I want to do is to have a script, macro of other "automated" tool that will simply break up the commentators' notes into sentences that are delimited from each other with a newline, followed by the sentence (which is begins with a date, as mentioned above).

To illustrate, here is an sanitized sample of a note cell provided by a commentator (the paragraph is enclosed in quotations, but they do not belong to the paragraph, if you follow me):

"04/01/2014 JPHO-DB: Memo with BC. 03/28/2014: JPHO-DB: 3/28 - CS routed Memo to BC for approval. Requires mandatory changes to the documents. 3/27 - CO approved Memo. 3/26 - CS sent Memo to Charley O. for review. 3/25 - docs approved by FTR and sent to DropBox. 02/27/2014 JPHO-DB: Boris K. spoke to Stanley F. about this issue on 2/24. Issue was carried over from 2013. Was originally certified 08/2013. FTR still does not have a complete package to process yet. Recommend office shelve the package if the requirement is no longer needed. Stanley F. will consult with Sri T. for decision. On 2/25, Dan M. submitted revised docs to FTR. On 2/27, Pat I. called the specialist informing her that the package will most likely be rejected. 02/11/2014 JPHO-DB: In response to my email on 2/10, Jerry L. informed me that Dan M. is sequestered for the eval activities and will not be available for any other work until next week. 02/04/2014 JPHO-DB: Deleted milestones since reviewing office does not have a complete package from Sri T. yet. Sent another reminder email to Sri T. today regarding missing documents. FTR has also been sending reminder emails to Sri T. re: delinquent documents."

Sorry for the long paragraph, folks, but this invented scenario is typical of what I have to manually parse for more than 300 Excel data rows, on a weekly basis (not that I'm crying in my beer about it, but still...)

So, recapping, you see in the paragraph above, all of it in a single cell (let's just call that cell Excel Cell J2), at each entry of a date (the first one is "04/02/2014", followed by the user's username in the database -- and no, I can't get my db gurus to filter so that the text comes out newline delimited -- already went down that path). Before each dated comment, I would like to insert a newline, followed by the sentence, then the next newline, the next sentence, and so on, until end of paragraph.

Is this possible? I'm simply acquiver with anticipation of your answers...Thank you all, in advance for applying your skills and knowledge to help me in this!

Best,

Rob

[Bernie Deitrick]

This will work for all cells starting at J2, continuing down the column. I tried to think of all the characters that might follow a date - if you find others, you can add them to the Clean function.

Option Explicit

Sub TestMacro()
    Dim rngC As Range
    Dim rngAll As Range
    Dim v As Variant
    Dim strV As String
    Dim i As Integer
    Dim d As Date

    'Set rngC = Range("J2")
    Set rngAll = Range("J2", Cells(Rows.Count, "J").End(xlUp))
    For Each rngC In rngAll
        strV = ""
        v = Split(rngC.Value, " ")

        On Error GoTo errhandler

        For i = LBound(v) To UBound(v)
            d = DateValue(Clean(v(i)))
            If strV = "" Then
                strV = v(i)
            Else
                If UCase(v(i - 1)) = "ON" Then
                    strV = strV & " " & v(i)
                Else
                    strV = strV & Chr(10) & v(i)
                End If
            End If
            GoTo DoNext
NotDate:
            If strV = "" Then
                strV = v(i)
            Else
                If Right(strV, 1) = "." And UCase(v(i)) = "ON" Then
                    strV = strV & Chr(10) & v(i)
                Else
                    strV = strV & " " & v(i)
                End If
            End If
DoNext:
        Next i

        On Error Resume Next
        rngC.Value = strV
        rngC.WrapText = True
    Next rngC

    rngAll.EntireRow.AutoFit
    rngAll.EntireColumn.Width = 100
    rngAll.EntireColumn.AutoFit

    Exit Sub

errhandler:
    Resume NotDate:
End Sub
Function Clean(S As Variant) As String
    Dim i As Integer
    Dim c As String
    Clean = S
    c = ":;'.,?!-=()[]{}"
    For i = 1 To Len(c)
        Clean = Replace(Clean, Mid(c, i, 1), "")
    Next i
End Function

[rmlowrie]

Top of the morning, Bernie! My apologies for just getting back to you. Let me first thank you so very much for the coding, especially because, except for a change here and there to fit my specific worksheet, this worked like a champ! I am very grateful! Awesome stuff!

~Rob

[Bernie Deitrick]

Better late...

Glad to hear that it worked!

Bernie