Inserting carriage returns into text strings of varying lengths

[pfisher99]

Hello - We are working on a CRM data migration project and I would like to insert a carriage return to create separate rows from a text string in excel. The export from the old CRM did not maintain the format of our notes, and instead can only export into a continuous text string. I would like to have them in their original format with carriage returns between each note.

Any help would be much appreciated, thanks!

An illustrative example of what I am looking to format below:

CURRENT FORMAT:

3/6/24: PF reach out to Craig to schedule lunch 2/7/24: PF reach out to Craig to schedule lunch 1/31/24: PF spoke with Craig at conference

WOULD LIKE TO APPEAR IN THE BELOW FORMAT:

3/6/24: PF reach out to Craig to schedule lunch 2/7/24: PF reach out to Craig to schedule lunch 1/31/24: PF spoke with Craig at conference

 

[Cubist]

Try on a copy.

Sub InsertLineBreaks()
    Dim regex As Object
    Dim matches As Object
    Dim inputText As String
    Dim outputText As String
    Dim match As Object
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim data As Variant
    Dim i As Long
 
    Set ws = ThisWorkbook.Sheets("Sheet1") 'change sheetname as needed
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    data = ws.Range("A2:A" & lastRow).Value 'assumes data starts in A2
 
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.pattern = "(\d{1,2}/\d{1,2}/\d{2}:\s)"
    For i = 1 To UBound(data, 1)
        If Not IsEmpty(data(i, 1)) Then
            inputText = data(i, 1)
            outputText = inputText
            Set matches = regex.Execute(inputText)
            For Each match In matches
                outputText = Replace(outputText, match.Value, vbLf & match.Value, 1, 1)
            Next match
            If Left(outputText, 1) = vbLf Then
                outputText = Mid(outputText, 2)
            End If
            data(i, 1) = outputText
        End If
    Next i
 
    'Output to column B
    ws.Range("B2:B" & lastRow).Value = data
    ws.Range("B2:B" & lastRow).WrapText = True
End Sub