Best Way to Split Strings

[iliauk]

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!

 

[iliauk]

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

'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:

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: