Link to home
Create AccountLog in
Avatar of John Carney
John CarneyFlag for United States of America

asked on

Parsing an alphanumeric string and reconstructing and distributing it.


I doubt that I phrased the question properly, but I need a macro or function that will look at a range of cells (say $A$1:$A$600), and when it finds a value like this:

42CDEF

it will parse and reconstruct and distribute the results (in Text to Columns fashion) to other cells like this:

42C    42D    42E    42F

It should ignore substrings that have only one letter after the number so that

12A will produce a blank;
12AC will produce 12A    12B;
3ABC, 5D, 17F, 24B will produce:  3A    3B    3C    17D    17F

The number can be anywhere from 1 to 3 characters, but it will always be at the start of the string.

Thanks!
John
ASKER CERTIFIED SOLUTION
Avatar of byronwall
byronwall

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Avatar of Travis Hydzik
have a look at the following function, getCells will take a string and return an array of cells.
Try the sub testme to see it in action.

Function getCells(ByRef s As String) As String()

    Dim strTemp As String
    Dim strTempOld As String
    strTempOld = vbNullString
    'find the break between number and letter
    For i = 1 To Len(s)
        strTemp = Mid$(s, i, 1)
        If Not IsNumeric(strTemp) Then
            If LenB(strTempOld) > 0 Then
                If IsNumeric(strTempOld) Then
                    'found the split
                    Exit For
                End If
            End If
        End If
        strTempOld = strTemp
    Next i
    
    Dim arr() As String
    Dim arrCount As Long
    arrCount = -1
    
    Dim tempStr1 As String
    Dim tempStr2 As String
    'confirm first are numbers
    tempStr1 = Mid$(s, 1, i - 1)
    If IsNumeric(tempStr1) Then
        tempStr2 = Mid$(s, i)
        If isLetter(tempStr2) Then
            For i = 1 To Len(tempStr2)
                arrCount = arrCount + 1
                ReDim Preserve arr(arrCount)
                arr(arrCount) = tempStr1 & Mid$(tempStr2, i, 1)
            Next i
        End If
    End If
    
    getCells = arr
End Function


Function isLetter(ByRef s As String) As Boolean
    isLetter = True
    Dim i As Long
    For i = 1 To Len(s)
        If IsNumeric(Mid$(s, i, 1)) Then
            isLetter = False
            Exit For
        End If
    Next i
End Function

Sub testerme()

Dim arr() As String
arr = getCells("42CDEF")

For i = 0 To UBound(arr)
    MsgBox arr(i)
Next i

End Sub

Open in new window

Avatar of John Carney

ASKER

Very awesome, thanks!

- John