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

 

[DanteAmor]

The result is just like the initial one:

With A1B2C3D4E5, it should output 1 2 3 4 5

There would be something like this. But the original idea was to avoid a loop, but it was not considered from the beginning.

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
            cad = ""
            For i = 2 To Len(c.Value) Step 2
                cad = cad & "x" & Mid(c.Value, i, 1)
            Next
            With CreateObject("VBScript.RegExp")
                .Pattern = "[A-Za-z]"
                .Global = True
                c.Offset(0, 5).Value = WorksheetFunction.Trim(.Replace(cad, " "))
                c.Offset(0, 5).TextToColumns Destination:=c.Offset(0, 5), Space:=True
            End With
        End If
    Next
End Sub

 

[kelly mort]

Okay now running smoothly.

I really appreciate your patience.

If you still have the patience to enlighten me on the lines I will be glad

 

[DanteAmor]

Replace the characters 1, 3, 5, 7, 9 with the letter "x", then, the following instructions the letter is replaced by a space and you know the rest.

            For i = 2 To Len(c.Value) Step 2
                cad = cad & "x" & Mid(c.Value, i, 1)
            Next

 

[kelly mort]

Replace the characters 1, 3, 5, 7, 9 with the letter "x", then, the following instructions the letter is replaced by a space and you know the rest.

            For i = 2 To Len(c.Value) Step 2
                cad = cad & "x" & Mid(c.Value, i, 1)
            Next

Oh okay. I see it.

So we make the cell content have those alphabet then we use the original code to complete the job.


Thanks a lot for it.

 

[DanteAmor]

That's right, that way the behavior will be the same.

 

[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

Hello @Fluff,

I just ran into a pitch and I need a pull out.

The A1B2C3 etc I used are supposed to be 112233 etc.

11 means question 1 option 1
22 means question 2 option 2 etc


Now when I get to question 10, I may have 101 which means :

Question 10 option 1.

But I realized the script will take the 0 instead of the last 1.


So since at the end of the 9th question the length of the string will be 18. That's 2 x9 , I need an adjustment which will fix that error for me.

Thanks