# Best Way to Split Strings

#### iliauk

##### Board Regular
Hi All,

I need a way to split strings similar to these:

beg45001.1-7 [into word:beg45001.], [numbera:1, numberb:7]
chung0011-42 [into word:chung00],[numbera:11,numberb:52]
abd343ae001-7 [into word:abd343ae00],[numbera:1,numberb:7]
XYZ3-7 [into word:XYZ], [numbera:3,numberb:7]
AB8-AB12[into word:AB],[numbera:8,numberb:12]

Would prefer not to use RegEx due to having to the references and so far have been using a mixture of Split into arrays; then looping with the Like function.

My idea would be to find "-" and then loop by character to the right which gives numberb, then move left until hitting either [A-Z0.] and that will be numbera and then anything to the left will be word.

Say:

For i = 1 To Len(strArray(k))
If UCase(Mid(strArray(k), i, 1)) Like "[A-Z0,]" Then

But I feel there is a neater/more powerful way.

Thanks very much!

Last edited:

### Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

#### iliauk

##### Board Regular
Hmm, so I ended up doing this. (Still curious of better way):

Code:
``````'Step one: split by "-"
strarray = Split(comstring(j), "-")
'Remove word at end
For i = Len(strarray(LBound(strarray))) To 1 Step -1
If Mid(strarray(LBound(strarray)), i, 1) Like "[0123456789]" Then
'Error Handling
Exit For
Else
last = Mid(strarray(LBound(strarray)), i, 1) & last
strarray(LBound(strarray)) = Mid(strarray(LBound(strarray)), 1, i - 1)
End If
Next i
If Not strarray(LBound(strarray)) = vbNullString Then
'Step two: extract numbers from first split
i = Len(strarray(LBound(strarray)))
Do While Mid(strarray(LBound(strarray)), i, 1) Like "[0123456789]"
numbera = numbera & Mid(strarray(LBound(strarray)), i, 1)
i = i - 1
'Error handling
If i = 0 Then Exit Do
Loop
' Fix the inversion
numbera = StrReverse(numbera)
worda = Mid(strarray(LBound(strarray)), 1, i)
'Step three: fix to keep the "0"s
i = 1
Do While Mid(numbera, i, 1) Like "[0]"
numbera = Mid(numbera, i + 1, Len(numbera))
worda = worda & "0"
Loop
' Finally fill with number
strarray(LBound(strarray)) = numbera * 1
End If``````

If anyone interesting, the final code is here:

Code:
``````Sub Expansion_Click()
Dim strfill, word, worda, wordb, numbera, numberb, last, temp As String
Dim strarray() As String
Dim comstring() As String
Dim strexp, i, j As Long
Dim rng, cell As Range
Set rng = Range(Range("A1"), Cells(Rows.Count, "A").End(xlUp))

For Each cell In rng
'STAGE1: Prepare string for splitting
'Replace all single/multiple spaces with "_":
For i = 1 To Len(cell.Value2)
If Mid(cell.Value2, i, 1) Like "[ ]" Then
If Mid(cell.Value2, i, 1) <> Mid(cell.Value2, i + 1, 1) Then
temp = temp & "_"
End If
Else
temp = temp & Mid(cell.Value2, i, 1)
End If
Next i
'Generate 'to' operator: "-"
temp = Replace(Replace(Replace(temp, "_-_", "-"), "_-", "-"), "-_", "-")
'Generate 'split' operator: "@"
temp = Replace(Replace(Replace(Replace(Replace(temp, "_,_", "@"), "_,", "@"), ",_", "@"), ",", "@"), "_", "@")
'STAGE2: Split final-formatted string
comstring = Split(temp, "@")
'Reset temp
temp = vbNullString
'Loop through all splits and process them
For j = LBound(comstring) To UBound(comstring)
'If not empty for robustness(, although shouldn't generate empty arrays)
If Not comstring(j) = vbNullString Then
'STAGE3: Split into word-prefix, numbera, and numberb
'Step one: split by "-"
strarray = Split(comstring(j), "-")
'Remove word at end
For i = Len(strarray(LBound(strarray))) To 1 Step -1
If Mid(strarray(LBound(strarray)), i, 1) Like "[0123456789]" Then
'Error Handling
Exit For
Else
last = Mid(strarray(LBound(strarray)), i, 1) & last
strarray(LBound(strarray)) = Mid(strarray(LBound(strarray)), 1, i - 1)
End If
Next i
If Not strarray(LBound(strarray)) = vbNullString Then
'Step two: extract numbers from first split
i = Len(strarray(LBound(strarray)))
Do While Mid(strarray(LBound(strarray)), i, 1) Like "[0123456789]"
numbera = numbera & Mid(strarray(LBound(strarray)), i, 1)
i = i - 1
'Error handling
If i = 0 Then Exit Do
Loop
' Fix the inversion
numbera = StrReverse(numbera)
worda = Mid(strarray(LBound(strarray)), 1, i)
'Step three: fix to keep the "0"s
i = 1
Do While Mid(numbera, i, 1) Like "[0]"
numbera = Mid(numbera, i + 1, Len(numbera))
worda = worda & "0"
Loop
' Finally fill with number
strarray(LBound(strarray)) = numbera * 1
End If
'''''''''''''''''''''''''''''''''''''''''
If UBound(strarray) > 0 Then
'Remove word at end
For i = Len(strarray(UBound(strarray))) To 1 Step -1
If Mid(strarray(UBound(strarray)), i, 1) Like "[0123456789]" Then
'Error Handling
Exit For
Else
'Only take one non-number ending
If last = vbNullString Then
last = Mid(strarray(UBound(strarray)), i, 1) & last
End If
strarray(UBound(strarray)) = Mid(strarray(UBound(strarray)), 1, i - 1)
End If
Next i
If Not strarray(UBound(strarray)) = vbNullString Then
'Step four: extract numbers from first split
i = Len(strarray(UBound(strarray)))
Do While Mid(strarray(UBound(strarray)), i, 1) Like "[0123456789]"
numberb = numberb & Mid(strarray(UBound(strarray)), i, 1)
i = i - 1
'Error handling
If i = 0 Then Exit Do
Loop
' Fix the inversion
numberb = StrReverse(numberb)
wordb = Mid(strarray(UBound(strarray)), 1, i)
'Step five: fix to keep the "0"s
i = 1
Do While Mid(numberb, i, 1) Like "[0]"
numberb = Mid(numberb, i + 1, Len(numberb))
wordb = wordb & "0"
Loop
' Finally fill with number
strarray(UBound(strarray)) = numberb * 1
End If
End If
'Step six: use longer word for prefix
If Len(worda) > Len(wordb) Then
word = worda
Else
word = wordb
End If
'STAGE4: Generate list
'''''''''''''''''''''''
'If we have two entries i.e. a range
If UBound(strarray) > 0 Then
'Set first output to first entry
strexp = strarray(LBound(strarray))
If strfill = vbNullString Then
strfill = word & strexp & last
Else
strfill = strfill + ", " & word & strexp & last
End If
'Iterate and add to fill string until equal to last entry
Do Until strexp = strarray(UBound(strarray))
'Forward or backwards depends on whether second entry bigger or smaller
If (strarray(UBound(strarray)) * 1) > (strarray(LBound(strarray)) * 1) Then
strexp = strexp + 1
Else
strexp = strexp - 1
End If
strfill = strfill & ", " & word & strexp & last
Loop
'If only single entry
Else
If j > 0 Then
strfill = strfill & ", " & word & Trim(strarray(0)) & last
Else
strfill = word & comstring(0) & last
End If
End If
'reset the temp strings
word = vbNullString
worda = vbNullString
wordb = vbNullString
numbera = vbNullString
numberb = vbNullString
last = vbNullString
'''''''''''''''''''''''''
'STAGE5: Fill with result
End If
Next j
'Fill cell next with expanded series
cell.Offset(, 1) = strfill
'Reset fill string
strfill = vbNullString
Next cell
End Sub``````

And it generates this:

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

1,164,626
Messages
5,838,438
Members
430,548
Latest member
hh_dh2001

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back