Loop through a range of selected cells and use text to column to split 1 cell across 4 columns

Question

I am trying to loop through a range of selected cells to split the text inside the cell across 3 or 4 columns from the activeCell.

This is a screen shot of the Excel file with the two examples, the top data is how it should be and after is the raw data that I need to split

I have the below code. If I take cell by cell it does the job but I need it to go through each cell and split the text in the range that I select also I would need a way to stop executing the code is the cell is empty and if the process was done before or it's not matching with any of the string length to continue the loop.

I don't know if the ElseIf was the right way to go. I was thinking to use a case statement instead to check and see which one of the split methods to use for each cell. The first example is easy but the second one is the tricky bit as when copying from Outlook you get some space and 1/ that I want to skip and not import in the text to column output. That is why for each cell I check the length of characters to determine the right split solution to use.

Sub splitStyleFabricColourSize()

Dim cellRow As Range
Dim mergedCells As Range
Dim cellInfo As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set mergedCells = Selection

On Error Resume Next

For Each cellRow In mergedCells.Cells
cellRow.Select

cellInfo = ActiveCell.Characters.Count
Debug.Print cellInfo

If cellInfo = 15 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1), Array(11, 1))

ElseIf cellInfo = 17 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth _
        , FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(7, 1), Array(12, 9), Array(13, 1))

ElseIf cellInfo = 18 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth _
        , FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(8, 1), Array(13, 9), Array(14, 1))

ElseIf cellInfo = 22 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth _
        , FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(7, 1), Array(12, 9), Array(13, 1), _
        Array(17, 9), Array(20, 1))

ElseIf cellInfo = 23 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(7, 1), Array(12, 9), Array(13, 1), _
        Array(17, 9), Array(21, 1))

ElseIf cellInfo = 24 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth, _
        OtherChar:="/", FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(7, 1), Array(12, _
        9), Array(13, 1), Array(17, 9), Array(22, 1))


ElseIf cellInfo = 25 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth _
        , OtherChar:="/", FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(7, 1), Array( _
        12, 9), Array(13, 1), Array(17, 9), Array(23, 1))

ElseIf cellInfo = 26 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth _
        , OtherChar:="/", FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(7, 1), Array( _
        12, 9), Array(13, 1), Array(17, 9), Array(22, 1))

ElseIf cellInfo = 27 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth _
        , OtherChar:="/", FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(8, 1), Array( _
        13, 9), Array(14, 1), Array(18, 9), Array(23, 1))

ElseIf cellInfo = 29 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth, _
        OtherChar:="/", FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(8, 1), Array(13, _
        9), Array(14, 1), Array(18, 9), Array(25, 1))

ElseIf cellInfo = 52 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth _
        , FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(7, 1), Array(12, 9), Array(13, 1), _
        Array(17, 9), Array(20, 1), Array(42, 9))

End If

Next cellRow
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

I'm stuck at a problem and wondering if you can help me. The number of character is 24 for both examples but the way they are below is different because of the "-" symbol so the text to column will pick it up differently. How would I go about solving this problem because the code below is different where you start separating the columns length. I did not anticipate this problem so.the code has a weakness in the end if the character count of the text is the same but different formatting then this will not work well. Is there a way to record a pattern like first string character in column 1 should have 6 digits and then second column should have 5 characters third column should have 4 digits and forth column should have 4 characters or more because clearly the array here is not helping me if the format that I receive from emails changes.

ElseIf cellInfo = 24 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth, _
        OtherChar:="/", FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(7, 1), Array(12, _
        9), Array(13, 1), Array(17, 9), Array(22, 1))
​
ElseIf cellInfo = 24 Then
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth _
        , OtherChar:="/", FieldInfo:=Array(Array(0, 1), Array(6, 9), Array(7, 1), Array( _
        12, 9), Array(14, 1), Array(18, 9), Array(20, 1))

Answer 1

Ok, I'm assuming those are spaces, right.

Sub TryThis()

'SPLIT INTO COLUMNS
ActiveSheet.Range("A1").Select
splitVals = Split(ActiveSheet.Range("A1").Value, " ")
totalVals = UBound(splitVals)
Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals

End Sub

This will split all selected cells (all cells in a selected range)..

Sub SplitCells()

Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next

Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
For Each Rng In WorkRng

splitVals = Split(Rng.Value, " ")
    totalVals = UBound(splitVals)
    Range(Cells(Rng.Row, ActiveCell.Column + 1), Cells(Rng.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals
Next
End Sub

Finally, and I'm not totally sure this is relevant, but based on your last comment, it sounds like you need the LEN function and the FIND function.
Description

The Microsoft Excel LEN function returns the length of the specified string.

The LEN function is a built-in function in Excel that is categorized as a String/Text Function. It can be used as a worksheet function (WS) and a VBA function (VBA) in Excel. As a worksheet function, the LEN function can be entered as part of a formula in a cell of a worksheet. As a VBA function, you can use this function in macro code that is entered through the Microsoft Visual Basic Editor. Syntax

The syntax for the LEN function in Microsoft Excel is:

LEN( text )

Description

The Microsoft Excel FIND function returns the location of a substring in a string. The search is case-sensitive.

The FIND function is a built-in function in Excel that is categorized as a String/Text Function. It can be used as a worksheet function (WS) in Excel. As a worksheet function, the FIND function can be entered as part of a formula in a cell of a worksheet. Syntax

The syntax for the FIND function in Microsoft Excel is:

FIND( substring, string, [start_position] )

Parameters or Arguments

substring The substring that you want to find. string The string to search within. start_position Optional. It is the position in string where the search will start. The first position is 1.