Divide cell contents based on where numbers appear

[mlarson]

Hi there, hope you all are doing well. Thanks in advance for helping me out with this, looking for a formula that can accomplish the following.

I would like the contents of cell A2 divided into separate cells with the results in B2, B3, B4, etc. Anytime a number appears in cell A2 (whether it's 1 digit, 2 digits, 3 digits... would like it recognized as one number, so 567 is one number), I would like that number and the characters that follow until the next number to be cut and pasted into a new cell (B2). Then the next number and characters that follow cut and pasted into a new cell (B3). So on and so forth (B4, B5, etc.).

For example...
In cell A2... 7 the way to do this 8 in excel is to 9 ask experts for help 10 and hope that you 11 are describing the problem 12 adequately.
Desired results...
B2: 7 the way to do this
B3: 8 in excel is to
B4: 9 ask experts for help
B5: 10 and hope that you
B6: 11 are describing the problem
B7: 12 adequately.

Thank you for taking a look and trying to help! -Mark

 

[ranman256]

adjust as needed. run: splitAllLInes

Option Explicit
   'this runs all rows
Public Sub splitAllLInes()
Dim r As Long
Range("A2").Select
r = ActiveCell.Row
While ActiveCell.Value <> ""
  split1NumLine
 
  ActiveCell.Offset(1, 0).Select  'next row
  r = ActiveCell.Row
  Cells(r, 1).Select   '1st col
Wend
MsgBox "done"
End Sub


  'this runs 1 row
Private Sub split1NumLine()
Dim vLine, vPart, vChr, vNum
vLine = Trim(ActiveCell.Value)
GoSub ProcessWord
'vNum = getNextNum(vLine)
'vPart = vNum
'vLine = Mid(vLine, Len(vNum) + 1)
'vChr = Left(vLine, 1)
While Len(vLine) > 0
    vChr = Left(vLine, 1)
    While Not IsNumeric(vChr) And Len(vLine) > 0
        vPart = vPart & vChr
        vLine = Mid(vLine, 2)
        vChr = Left(vLine, 1)
    Wend
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = vPart
  
    If Len(vLine) > 0 Then
       vPart = ""
       GoSub ProcessWord
    End If
Wend
ActiveCell.Value = vPart
Exit Sub

'-------------
ProcessWord:
'-------------
    vNum = getNextNum(vLine)
  
    vPart = vNum
    vLine = Mid(vLine, Len(vNum) + 1)
Return
End Sub

Private Function getNextNum(ByVal pvLine)
Dim vNum, vChr
 
vChr = Left(pvLine, 1)
pvLine = Mid(pvLine, 2)
While IsNumeric(vChr)
  vNum = vNum & vChr
  vChr = Left(pvLine, 1)
  pvLine = Mid(pvLine, 2)
Wend
getNextNum = vNum
End Function

 

[mlarson]

Thank you, appreciate it!