Split content of a cell into different cells with vba

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,796
Office Version
  1. 2016
Platform
  1. Windows
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
 

Some videos you may like

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
Joined
Jun 12, 2014
Messages
46,010
Office Version
  1. 365
Platform
  1. Windows
How about
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
Joined
Apr 10, 2017
Messages
1,796
Office Version
  1. 2016
Platform
  1. Windows
How about
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
Joined
Jun 12, 2014
Messages
46,010
Office Version
  1. 365
Platform
  1. Windows
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
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,796
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Oh okay.

Very cool.

Well understood.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
How about

Code:
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

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,307
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

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
Joined
Apr 10, 2017
Messages
1,796
Office Version
  1. 2016
Platform
  1. Windows
How about

Code:
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

Well-known Member
Joined
Apr 10, 2017
Messages
1,796
Office Version
  1. 2016
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,108,506
Messages
5,523,305
Members
409,509
Latest member
CheekyDevil2386

This Week's Hot Topics

Top