# Split content of a cell into different cells with vba

#### kelly mort

##### Well-known Member
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 .

### Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},\$Z\$1:\$Z\$99,\$Y\$1:\$Y\$99),2,False) to lookup Y values to left of Z values.

#### Fluff

##### MrExcel MVP, Moderator
Code:
``````Sub kellymort()
Dim Cl As Range
Dim i As Long

For Each Cl In Range("D2", Range("D" & Rows.Count).End(xlUp))
If Not Cl.Value = "" Then
For i = 2 To Len(Cl) Step 2
Cl.Offset(, 4 + i / 2).Value = Mid(Cl, i, 1)
Next i
End If
Next Cl
End Sub``````

#### kelly mort

##### Well-known Member
Code:
``````Sub kellymort()
Dim Cl As Range
Dim i As Long

For Each Cl In Range("D2", Range("D" & Rows.Count).End(xlUp))
If Not Cl.Value = "" Then
For i = 2 To Len(Cl) Step 2
Cl.Offset(, 4 + i / 2).Value = Mid(Cl, i, 1)
Next i
End If
Next Cl
End Sub``````

Exactly what I am looking for.

I appreciate it

what does this

Code:
`` Cl.Offset(, 4 + i / 2).Value = Mid(Cl, i, 1)``

Do?

Last edited:

#### Fluff

##### MrExcel MVP, Moderator
You're welcome & thanks for the feedback.
this part
Code:
``Cl.Offset(, 4 + i / 2).Value``
decides the number of columns to offset from col D, so for the first pass through the loop i=2 so 4+i/2 is 4+1 so offset 5 columns.
On the second pass i=4 so 4+4/2 is 4+2 so offset 6 columns

This part
Code:
``Mid(Cl, i, 1)``
takes the k-th letter from the string, so on the first pass i=2 so it returns the 2nd character, on the second pass i=4 so you get the 4th character.

HTH

Oh okay.

Very cool.

Well understood.

#### DanteAmor

##### Well-known Member

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

#### Rick Rothstein

##### MrExcel MVP

Here is one more way (non-looping)...
Code:
``````[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]``````

#### kelly mort

##### Well-known Member

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

This code gave an error :

Application-define or object-define error

#### kelly mort

##### Well-known Member
Here is one more way (non-looping)...
Code:
``````[TABLE="width: 500"]
<tbody>[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]
</tbody>[/TABLE]``````

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

#### DanteAmor

##### Well-known Member
This code gave an error :

Application-define or object-define error

In which line does the error mark you?
And what version of excel do you have?

Replies
16
Views
132
Replies
0
Views
43
Replies
20
Views
112
Replies
3
Views
32
Replies
5
Views
52