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
byronwall

membership
Create an account to see this answer
Signing up is free. No credit card required.
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``````