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

 

[Fluff]

How about

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]

How about

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

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

Do?

 

[Fluff]

You're welcome & thanks for the feedback.
this part

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

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

 

[kelly mort]

Oh okay.

Very cool.

Well understood.

 

[DanteAmor]

How about

Sub toColumn()
    Dim c As Range
    Application.DisplayAlerts = False
    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]

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]

 

[kelly mort]

How about

Sub toColumn()
    Dim c As Range
    Application.DisplayAlerts = False
    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]

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

[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]

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?