Is there a vba code that can parse out specific data from a single cell that has multiple paragraphs in excel?

Question

I am in need of some help please. I have found multiple vba codes that can help with pulling certain characters in a cell, but the trouble I am having is that a single cell has multiple paragraphs where I need specific information parsed out and placed into its own rows with the rest of the row data copied over from the cell it needs to be parsed from. Below is an example of a cells data.

ABC:123456
This is where the paragraph starts, each paragraph is different, then at the end it include something like this.
Updates: Notes Aligned: ABCD-123
Updates: Notes Old: ABC-0125

(Note: some paragraphs are separated by multiple tabbing spaces)

ABC:789012
This is where the paragraph starts, each paragraph is different, then at the end it include something like this.
Updates: Notes Aligned: ABCD-123
Updates: Notes Old: ABC-0125

Update: above each paragraph there is something like ABC:123456 which is all I need to parse out to it’s own rows, the numbers after the “:“ are all different as well. I don’t need the text/references below it, just the 3 letters, the colon character, and the number that follows (ABC:######). There are multiple cells that have anywhere from 2 to 10 of these paragraphs. Reason I prefer to use vba code so when the data is uploaded, excel is automatically updated to parse the data. Please help?

I have tried multiple vba codes, formulas, and power query but it’s time consuming trying to get just the top row of the paragraphs. Especially when my data is at 10,000 plus.

Data: Example data

Answer 1

You can use Regex.
This will get the value starting with ABC: and then six digits

    Dim regEx As New RegExp

    With regEx
        .Global = True
        .Pattern = "ABC:\d{6}"
    End With
    
    
    Set Matches = regEx.Execute(Range("A1").Value)
    ABC = Matches.Item(0).Value

Answer 2

If you're using 365, You can use formula to calculate the part in column H as following:

=FILTERXML("<t><s>"&SUBSTITUTE(H2,CHAR(10),"</s><s>")&"</s></t>","//s[starts-with(.,'ABC:')]")

You can see more about filterxml here: Excel - Extract substring(s) from string using FILTERXML

Answer 3

Option Explicit

Sub Demo()
    Dim res(), arrData, arrMatch, arrRes, aKey
    Dim n As Long, i As Long, j As Long
    Dim RowCnt As Long, ColCnt As Long, iR As Long
    Dim objRegExp As Object, srcSht As Worksheet
    Dim objMatch As Object
    Const KEY_COL = 7 ' search in KEY_COL
    ' Load data from ActiveSheet
    Set srcSht = ActiveSheet
    arrData = srcSht.[a1].CurrentRegion
    RowCnt = UBound(arrData)
    ColCnt = UBound(arrData, 2)
    ReDim arrMatch(1 To RowCnt)
    n = 0
    Set objRegExp = CreateObject("vbScript.Regexp")
    With objRegExp
        .Global = True
        .Pattern = "(ABC:\d{6})"
        ' Collect match results
        For i = 2 To RowCnt
            Set objMatch = objRegExp.Execute(Trim(arrData(i, KEY_COL)))
            If objMatch.Count > 0 Then
                n = n + objMatch.Count
                For j = 0 To objMatch.Count - 1
                    If j = 0 Then
                        arrMatch(i) = objMatch(j)
                    Else
                        arrMatch(i) = arrMatch(i) & " " & objMatch(j)
                    End If
                Next
            End If
        Next
    End With
    iR = 0
    ' Populate output array
    ReDim arrRes(1 To n, 1 To ColCnt)
    For i = 2 To RowCnt
        If Len(arrMatch(i)) > 0 Then
            For Each aKey In Split(arrMatch(i))
                iR = iR + 1
                For j = 1 To ColCnt
                    If j = KEY_COL Then
                        arrRes(iR, j) = aKey
                    Else
                        arrRes(iR, j) = arrData(i, j)
                    End If
                Next
            Next
        End If
    Next
    ' Write output to sheet
    Sheets.Add
    srcSht.Rows(1).Copy Range("A1")
    Range("A2").Resize(n, ColCnt).Value = arrRes
    ActiveSheet.UsedRange.EntireColumn.AutoFit
    Set objRegExp = Nothing
    Set objMatch = Nothing
End Sub