Reply to thread

Message: [QUOTE="Ron Rosenfeld, post: 7393757"] Given that new information, I have modified my VBA Macro: ================================== Option Explicit Sub ParsePOC() Dim rg As Range, c As Range Dim re As Object, mc As Object Dim s As String Dim i As Long, j As Long Dim sPat As Variant Set rg = Range("A1", Cells(Rows.Count, "A").End(xlUp)) Set re = CreateObject("vbscript.regexp") With re .Global = True .MultiLine = False .ignorecase = True End With sPat = Array("When\s+([\s\S]+?)(?=\s+is)", _ "is\s+([^,]+)", _ "Assigned\s+POC\s+to\s+([\s\S]+?)(?=,(?:(?:\s*and\s*change)|(?:\s*change))|$)", _ "Alt\.\s*POC\s*to\s*([\s\S]+?)(?=,(?:(?:\s*and\s*change)|(?:\s*change))|$)", _ "Substitute\s*POC\s*to\s*([\s\S]+?)(?=,(?:(?:\s*and\s*change)|(?:\s*change))|$)") Range(rg(1, 2), rg(rg.Rows.Count - 1, 6)).ClearContents For Each c In rg re.Pattern = "[\r\n]+" s = Trim(re.Replace(c.Text, " ")) For i = LBound(sPat) To UBound(sPat) re.Pattern = sPat(i) If re.test(s) = True Then Set mc = re.Execute(s) c(1, i - LBound(sPat) + 2).Value = mc(0).submatches(0) End If Next i Next c End Sub ======================================== [/QUOTE]