Best Way to Split Strings

iliauk

Board Regular
Joined
Jun 3, 2014
Messages
163
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]
AD3-AE6[into word:]*empty as AD=/AE, [numbera:3,numberb:6]

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
Joined
Jun 3, 2014
Messages
163
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:

Expand.png
 
Master Excel Bundle

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.

Forum statistics

Threads
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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top