VBA Splitting a String into multiple cells when it has variable Delimiters - excel

Question

If I have the below info all contained in a single cell and I want to split it into separate cells. I understand how to use the space as a delimiter but in this case, the name also has spaces and I want the name to stay together in a single cell. To further complicate the matter, the name is not always just first and last, it can also include middle so is not always a standard two names.
2172571122 Jane Doe 3143332222 John Doe
2172242237 Mary Mixer 2223334444 Mike M Martin
Want it to end up looking like this:
Cell 1 = 2172242237
Cell 2 = Mary Mixer
Cell 3 = 2223334444
Cell 4 = Mike M Martin
Any suggestions?

Answer 1

This regex based function alternates each split between numbers and text (words).
Option Explicit
Function customSplit(str As String, _
Optional ndx As Integer = 1) As Variant
Static rgx As Object, cmat As Object
Set rgx = CreateObject("VBScript.RegExp")
With rgx
.Global = True
.MultiLine = True
.IgnoreCase = True
If CBool(ndx Mod 2) Then
.Pattern = "[0-9]{10}"
ndx = (ndx + 1) \ 2
Else
.Pattern = "[A-Z]{1,9}\s[A-Z]{1,9}[\s[A-Z]{1,9}]?"
ndx = ndx \ 2
End If
If .test(str) Then
Set cmat = .Execute(str)
If ndx <= cmat.Count Then
customSplit = cmat.Item(ndx - 1)
End If
End If
End With
End Function

Answer 2

You could try:
Option Explicit
Sub test()
Dim strToSplit As String, strImport As String
Dim arrwords As Variant
Dim i As Long, counter As Long
With ThisWorkbook.Worksheets("Sheet1")
strToSplit = .Range("A1").Value
arrwords = Split(strToSplit, " ")
counter = 1
For i = LBound(arrwords) To UBound(arrwords)
If IsNumeric(arrwords(i)) = True Then
strImport = arrwords(i)
.Cells(3, counter).Value = strImport
counter = counter + 1
ElseIf Not IsNumeric(arrwords(i)) = True Then
If Not IsNumeric(.Cells(3, counter - 1).Value) Then
strImport = .Cells(3, counter - 1) & " " & arrwords(i)
.Cells(3, counter - 1).Value = strImport
counter = counter
Else
strImport = arrwords(i)
.Cells(3, counter).Value = strImport
counter = counter + 1
End If
End If
Next
End With
End Sub
Results look like this:

Answer 3

I have a few ideas on what you could do.
1) Read a Line
Do a split(line, " ") and loop through the indecies while performing a isNumeric() on each split value. If not, then add to a string Array() and set a flag to true.
Then, if isnumeric then, expect another name and set flag to true.
2) Read a line.
Then, loop through each character performing an isnumeric and if not then add that character to a string Array() and set flag until isnumeric again, etc....
I hope that helps or at least gets you in the right direction.

Answer 4

Additional variant to posted already:
Sub ZZZ()
Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
Dim num$, cl As Range, data As Range, key, x
Dim Result As Worksheet
Set data = Range([A1], Cells(Rows.Count, "A").End(xlUp))
For Each cl In data
x = "": num = "":
For Each x In Split(cl, " ")
If IsNumeric(x) Then
num = x
dic.Add x, ""
ElseIf x <> "" And num <> "" Then
dic(num) = Trim(dic(num) & " " & x)
End If
Next x
Next cl
Set Result = Worksheets.Add
With Result
.Name = "Result " & Replace(Now, ":", "-")
x = 1
For Each key In dic
.Cells(x, "A").Value2 = key
.Cells(x, "B").Value2 = dic(key)
x = x + 1
Next key
.Columns("A:B").AutoFit
End With
End Sub
test: