On Dec 1 2011, 9:08*pm, Ron Rosenfeld wrote:
On Thu, 1 Dec 2011 13:00:21 -0800 (PST), Willie wrote:
Thanks for your help. This got me going but I still have an Error for
the POCs since they are not in a uniform order.

Given that new information, I have modified my VBA Macro:

==================================
Option Explicit
Sub ParsePOC()
* * Dim rg AsRange, c AsRange
* * 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
========================================

Thanks Ron...this worked very nice. I move my data so I ended up with
this.

Option Explicit
Sub AssigmentParsePOC()
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

'Where to start
'Set rg = Range("A1", Cells(Rows.Count, "A").End(xlUp))
Set rg = Range("C2", Cells(Rows.Count, "C").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))|$)", _
"Substitute-2\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

'Insert a header row
InsertHeaderRowAssigment

End Sub