Split content of a cell into different cells with vba

[kelly mort]

I have in column D strings like

A1B1C1D1E1 or A5B1C3D1E4 etc

There can be blanks too. There length will always be even if not blank.

Which means we can have from 2 characters up to 10 characters.

So from the above given example if cell D2 is having A5B1C3D1E4, then I am splitting it and filling from I2 to M2 with

5, 1, 3, 1, 4

Then we repeat that to last used row in D.

So if length of the string is not up to 10, then the remaining cells in col I to M is filled with blank.

I hope this is possible .

Thanks in advance

 

[kelly mort]

It does not mark any line.

I am using 2016 64-bits

 

[DanteAmor]

I guess it's something from the version that does not recognize

CreateObject("VBScript.RegExp")

Check menu VBA / Tools / References , the following are marked:

Visual Basic for Applications
Microsoft excel xx Object library
Ole automation
Microsoft office xx object library

Note: xx is your version

 

[Fluff]

Dante's code works for me as long as there no blanks in the range, in which case I get an error 1004 No data was selected to parse.

 

[kelly mort]

I guess it's something from the version that does not recognize

CreateObject("VBScript.RegExp")

Check menu VBA / Tools / References , the following are marked:

Visual Basic for Applications
Microsoft excel xx Object library
Ole automation
Microsoft office xx object library

Note: xx is your version

They are all checked already.

I think they are caused by the blanks as @Fluff pointed out

 

[Rick Rothstein]

Here is one more way (non-looping)...

[table="width: 500"]
[tr]
	[td]Sub kellymort()
  With Range("D2", Cells(Rows.Count, "D").End(xlUp))
    .Offset(, 5).Resize(, 5) = Evaluate("IF({1},MID(" & .Address & ",{2,4,6,8,10},1))")
  End With
End Sub[/td]
[/tr]
[/table]

This one is cute.
I will be glad if you can explain the line between the with statement

The left side of the equal sign references the cells from D2 down to the last data cell in Column D and moves that reference over 5 columns and then increases the size of that offset range by 5 columns. That produces a two-dimensional range 5 columns wide starting at Column I and as many rows deep as the maximum extent of rows of data in Column D. The Evaluate function on the right will create a two-dimensional array of values to fill this two-dimensional range of cells. The way Evaluate works is it takes a text string representation of an Excel formula (which we can concatenate together from various pieces of text) and returns an array of values in the same way Excel would do when it would calculates the formula. Note that if the formula produces a single value instead of an array of values, the Evaluate function would do the same (but that case does not apply to your request). The address that the formula will use comes from the range referenced in the With statement. For example purposes, lets say your data in Column D runs from Row 2 to Row 9... then address that will be concatenated into the Evaluate's formula would be D2:D9 and the argument to the Evaluate function would become this...

"IF({1},MID(D2:D9,{2,4,6,8,10},1))"

So, this is an array formula so Excel (via the Evaluate function) will calculate this formula, first for cell D2, then D3, then D4, etc. and the position in the text that the MID function grabs characters from comes from the array constant inside the curly braces... the first position will be the 2nd character (where your first number is located at), then next position will be the 4th character (where your second number is located at) and so on until the 10th character position (where your last number is located at)... the third argument for the MID function is 1 which means it will only grab one character per text it processes. Taken together, this creates an output of values from Row 2 to 9 (for our assumed example) and across 5 columns of values (which were picked out of the original text at positions 2, 4, 6, etc.)... that array of values is what is assigned to the range of cells referenced on the left side of the equal sign. Note that the MID function returns nothing if the character position specified for its second argument is beyond the last character of the text being evaluated, so we do not have to do anything special for short or non-existent text. Now, just one more piece of the formula needs to be addressed.. the IF function call. Text functions such as MID are not natively array aware meaning calling them directly will not produce an array of values even if an array is supplied to them; however, if a text function is embedded inside a function that is array aware, it will "induce" array awareness into the text function (I do not think this statement is technically correct, but it is the net effect of the process). The {1} is an array (of one value) so the IF function that array is supplied to ends up making the entire formula array aware so that we end up with an array of values from the MID function call.

 

[DanteAmor]

They are all checked already.

I think they are caused by the blanks as @Fluff pointed out

In this case

Sub toColumn()
    Dim c As Range
    Application.DisplayAlerts = False
    For Each c In Range("D2", Range("D" & Rows.Count).End(xlUp))
        If c.Value <> "" Then
            With CreateObject("VBScript.RegExp")
                .Pattern = "[A-Za-z]"
                .Global = True
                c.Offset(0, 5).Value = WorksheetFunction.Trim(.Replace(c.Value, " "))
                c.Offset(0, 5).TextToColumns Destination:=c.Offset(0, 5), Space:=True
            End With
        End If
    Next
End Sub

 

[kelly mort]

In this case

Sub toColumn()
    Dim c As Range
    Application.DisplayAlerts = False
    For Each c In Range("D2", Range("D" & Rows.Count).End(xlUp))
        If c.Value <> "" Then
            With CreateObject("VBScript.RegExp")
                .Pattern = "[A-Za-z]"
                .Global = True
                c.Offset(0, 5).Value = WorksheetFunction.Trim(.Replace(c.Value, " "))
                c.Offset(0, 5).TextToColumns Destination:=c.Offset(0, 5), Space:=True
            End With
        End If
    Next
End Sub

So after reading the code carefully, I spotted what was causing the error :

1. The first one was that if statement you fixed.
2. The second is this line:

.Pattern = "[A-Za-z]"

So I changed it to

.pattern = "[A-Za-z, 0-9]"

Because what I have here are all numbers I used the A B etc to make my post readable.


My fix did not work

 

[DanteAmor]

If you have the data as below, you should not have any problem.



<b>Sheet</b><br /><br /><table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:80px;" /><col style="width:120px;" /><col style="width:80px;" /><col style="width:80px;" /><col style="width:80px;" /><col style="width:80px;" /><col style="width:80px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >D</td><td >I</td><td >J</td><td >K</td><td >L</td><td >M</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td > </td><td style="background-color:#ffff00; ">A1B2C3D4E5</td><td style="text-align:right; ">1</td><td style="text-align:right; ">2</td><td style="text-align:right; ">3</td><td style="text-align:right; ">4</td><td style="text-align:right; ">5</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td > </td><td style="background-color:#ffff00; ">A5B1C3D1E4</td><td style="text-align:right; ">5</td><td style="text-align:right; ">1</td><td style="text-align:right; ">3</td><td style="text-align:right; ">1</td><td style="text-align:right; ">4</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td > </td><td style="background-color:#ffff00; ">M5N8G3T4P9</td><td style="text-align:right; ">5</td><td style="text-align:right; ">8</td><td style="text-align:right; ">3</td><td style="text-align:right; ">4</td><td style="text-align:right; ">9</td></tr></table> <br /><br />

Maybe if you tell me how you have the data and in which of them you have the error, and which error it sends you and in which line the macro stops, I'll gladly review it.

 

[kelly mort]

For what I am running this test on, col D has no letters.

It's all numbers.

The code worked when I have them with letters as shown in your current post.

 

[Rick Rothstein]

@kelly mort,

Just wondering...

1) Did the code I posted in Message #9 work for you or not?

2) Did you see the explanation of my code that you asked for in Message #15 ?