Sub test()
Dim txt As String, m As Object, temp As String, pref As String, x As Long, r As Range
For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
txt = r.Value: r(, 2).ClearContents
With CreateObject("VBScript.RegExp")
.IgnoreCase = True
.Global = True
.Pattern = "([^,]+), *(.*)"
pref = .Execute(txt)(0).submatches(0)
temp = .Execute(txt)(0).submatches(1)
.Pattern = "\b(\S)"
For Each m In .Execute(temp)
r(, 2).Value = r(, 2).Value & m
Next
r(, 2).Value = pref & r(, 2).Value
.Pattern = "\band "
temp = .Replace(txt, "")
.Pattern = "[, ]"
r(, 3).Value = .Replace(temp, "")
.Pattern = "([^, ])(?!($| ))"
r(, 4).Value = .Replace(txt, "$1 ")
temp = txt
.Pattern = "\S+"
Do While .Execute(temp).Count > 5
Set m = .Execute(txt)
x = CreateObject("System.Random").Next_2(1, m.Count + 1)
temp = Application.Replace(temp, m(x - 1).firstindex + 1, m(x - 1).Length, "")
Loop
.Pattern = "([^, ])(?!($| ))"
r(, 5).Value = .Replace(temp, "$1 ")
.Pattern = " *, *"
temp = .Replace(txt, " ")
.Pattern = "\band "
temp = .Replace(temp, "AND")
.Pattern = " +"
r(, 6).Value = .Replace(temp, "XXX")
End With
Next
End Sub
Bookmarks