View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Ron Rosenfeld[_2_] Ron Rosenfeld[_2_] is offline
external usenet poster
 
Posts: 1,045
Default Cell Range Split into Multiple Cells

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 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
========================================