How to seperate each character and place it in its own cell?

krazykaj

Board Regular
Joined
Jul 20, 2005
Messages
143
Hello all,

I have an unsual question/task that I hope I may be able to get some help with. :wink:
I want to be able to take a collection of letters (a sentence or something like that) and be able to separate each individual character and place it in its own cell.

Probably will make more sense with an example:

I have two sheets. Sheet1 has the source data; Sheet2 is the sheet in which I’d like to place the result.

So, say in Sheet1 I have the following: (Please note that the ‘spaces’ are important)(I needed to put it in 'code' format so that the multiple 'spaces' were kept, and not removed by the forum)

Cell A1 contains the following:
Code:
 CCC     A     TTTTTTT

Cell A2 contains:
Code:
C       A A       T

Cell A3 contains:

Code:
C      A   A      T

Cell A4 contains:
Code:
C     AAAAAAA     T

Cell A5 contains:
Code:
 CCC A       A    T

Now, here is what I’d like to happen.
I would like a 'code' to go though each cell, take its contents, and separate each individual character and then place each of these individual characters into consecutive cells or the same row.

So, the formula would first take the contents of cell A1 on Sheet1 i.e. “ CCC A TTTTTTT”.
This would be taken apart, and on Sheet2 each character would be plotted into a separate cell on the same row.

So cell A1 on Sheet2 would contain a ‘space’ (appear to be blank),
cell B1 would contain a “C”,
cell C1 would contain a “C”,
cell D1 would contain a “C”,
cell E1 would contain a ‘space’,
cell F1 would contain a ‘space' ... and so on.

Once the first line has been separated and plotted, you’d move onto the next line.
And after each of the above cells is plotted, if you make the size (width, height) of your cells in Sheet2 square, the word/shape “CAT” should be formed.

Another example:
If I had in Sheet1:

Cell A1:
Code:
X     X
Cell A2:
Code:
 X   X
Cell A3:
Code:
  X X
Cell A4:
Code:
   X
Cell A5:
Code:
  X X
Cell A6:
Code:
 X   X
Cell A7:
Code:
X     X

And then I did the same process of separating each character from each line (with spaces to be included as characters) and then plotted each of these character into its own separate cell on Sheet2, and if Sheet2 has ‘square-shaped’ cells, a big letter “X” would be formed.

Is there an easy way I could create ‘code’ that would enable me to do this?

I hope that the above made sense ... :cool:

Thank you all for any help you may be able to provide :biggrin:

Thanks for your time,
Cheers
KJ
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Yup, this one's unusual...

Does this do what you need? It will parse the data using the range you've selected prior to running the code.

Code:
Option Explicit

Sub Extract()
Dim CellLength As Long, i As Long
Dim CopyRange As Range, c As Range
Dim DestRange As Range

Set CopyRange = Selection
Sheets.Add
Set DestRange = Range("A1")
For Each c In CopyRange
    CellLength = Len(c)
    For i = 1 To CellLength
        DestRange = Mid(c, i, 1)
        Set DestRange = DestRange.Offset(, 1)
    Next i
    Set DestRange = Cells(DestRange.Row + 1, 1)
Next c

End Sub

Regards,
 
Upvote 0
Hi Barrie,

Brilliant! works great

I did however modify things it a bit: :biggrin: (I hope you don't mind)

Code:
Option Explicit

Sub Extract()
Dim CellLength As Long, i As Long
Dim CopyRange As Range, c As Range
Dim SelectionRange As Range, sr As Range
Dim DestRange As Range

Set SelectionRange = Selection
    For Each sr In SelectionRange
    sr.Select

        Set CopyRange = Selection
        Set DestRange = Sheets(2).Cells(CopyRange.Row, 1)
        For Each c In CopyRange
            CellLength = Len(c)
            For i = 1 To CellLength
                DestRange = Mid(c, i, 1)
                Set DestRange = DestRange.Offset(, 1)
            Next i
            Set DestRange = Cells(DestRange.Row + 1, 1)
        Next c

Next sr

End Sub

So now (using the 'CAT' example), you need to just select cells A1-A5 with the source text in it, and run the code (making sure you have a second spare sheet) and it should work nicely, seperating each character to its own cell.

Thankyou very much for the help, much appreciated.
If anybody can imporve/enhance things, please let me know :)

Thanks again,
Cheers
KJ
 
Upvote 0
How about this?
Code:
Sub Extract()
Dim CellLength As Long, i As Long
Dim CopyRange As Range, c As Range
Dim DestRange As Range

Set CopyRange = Selection
For Each c In CopyRange
    Set DestRange = Sheets(2).Cells(CopyRange.Row, 1)
    CellLength = Len(c)
    For i = 1 To CellLength
        DestRange = Mid(c, i, 1)
        Set DestRange = DestRange.Offset(, 1)
    Next i
    Set DestRange = Cells(DestRange.Row + 1, 1)
Next c

End Sub

It eliminates selecting cells (just what you've got selected to begin with) which slows down code.
 
Upvote 0
how about this? rename the sheet to "data" and data start in A1 down. you dont need to select the range, just run the code.
Code:
Sub sample()
Dim wsnew As Worksheet
Dim i, ii, iii, iiii As Long
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("result").Delete
Application.DisplayAlerts = True
Sheets.Add after:=Sheets("data")
Sheets(Sheets.Count).Name = "result"
Set wsnew = Sheets("result")
For i = 1 To Sheets("data").Range("a" & Rows.Count).End(xlUp).Row
    ii = Len(Sheets("data").Cells(i, "a").Value) + 1
        For iii = 1 To ii
            Sheets("result").Cells(i, iii).Value = Mid(Sheets("data").Cells(i, "a").Value, iii, 1)
        Next
Next
Sheets("result").Columns("a:aa").AutoFit
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi there

For a formula solution, type this in any cell in row 1, scroll right as far as needed, then scroll all down as far as needed:

=MID($A1,COLUMN(A1),1)

regards
Derek
 
Upvote 0

Forum statistics

Threads
1,213,487
Messages
6,113,941
Members
448,534
Latest member
benefuexx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top