View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Mr_Huang Mr_Huang is offline
external usenet poster
 
Posts: 3
Default Splitting one single cell into pieces

thank you for your help,
however, i'm pretty new to vb in excel.
How can I run this formula? Cannot find this in the run menu of
Microsoft VB - Marco dialogs.

Further illustration:

A B C D
1 a Apple 12 as01
b
c
d
2 e Orange 80 os23
f
g
h
3 i Grape 200 gs44
j
k
l
and so on.
where "column A" will contain multiple value in a single cell, want to
split the single cell into multiple cells and duplicate the other cell
to the following lines,

Result:
A B C D
1 a Apple 12 as01
2 b Apple 12 as01
3 c Apple 12 as01
4 d Apple 12 as01
5 e Orange 80 os23
6 f Orange 80 os23
7 g Orange 80 os23
8 h Orange 80 os23
9 i Grape 200 gs44
10 j Grape 200 gs44
11 k Grape 200 gs44
12 l Grape 200 gs44

is it possible?
How can I run this to my excel worksheet?
or is it a formula ?
tia,
Huang

On 8$B7n(B13$BF|(B, $B2<8a(B8$B;~(B32$BJ,(B, Lars Uffmann wrote:
Mr_Huang wrote:
how can I use formula to
1. split the single cell into multiple cells (4 different cells)


If you are happy with putting them in horizontally oriented cells, I
would recommend Excel's TextToColumns method:

Range ("A1").Value = "a" & vbCr & "b" & vbCr & "c" & vbCr & "d"
Range ("A1").TextToColumns Destination:=Range ("B1"),
DataType:=xlDelimited, Other:=True, OtherChar:=vbCr

This will split your single cell into multiple cells, but horizontally -
e.g.

A B C D E
1 a a b c d
b
c
d
2
3

If you want it vertically arranged, you will have to do it manually in
code I think.

Just created a function for you, see below.

HTH,

Lars

' Function: TextToRows
' Version: 2008-08-13
' Purpose: split a the delimiter-separated cells in a column into
' separate rows
' Example Usage: TextToRows (1, 2, 20, 45, ";")
Public Sub TextToRows(sourceCol As Long, _
Optional destCol As Long = -1, _
Optional fromRow As Long = 1, _
Optional toRow As Long = -1, _
Optional delimiter As String = vbCr)

Dim sourceRow As Long, destRow As Long
Dim rowStart As Long, rowEnd As Long
Dim sourceRowValue As String, rowValue As String

If (destCol = sourceCol) Then
MsgBox "Can not use source column as destination for " _
& "converted data!", vbCritical, "conversion failure"
End If

If (destCol = -1) Then
destCol = sourceCol + 1 ' default: write into next column
End If
If (toRow = -1) Then
' determine the highest used row number in the source column
toRow = Columns(sourceCol).Find("*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).row
End If

destRow = fromRow
For sourceRow = fromRow To toRow
sourceRowValue = Cells(sourceRow, sourceCol).value
rowStart = 1 ' start searching for delimiter at first character
Do
' find next delimiter
rowEnd = InStr(rowStart, sourceRowValue, delimiter)

If (rowEnd = 0) Then ' no delimiter found
' get remaining cell data
rowValue = Mid(sourceRowValue, rowStart)
Else
' get string between delimiters
rowValue = Mid(sourceRowValue, rowStart, _
rowEnd - rowStart)
End If
Cells(destRow, destCol).value = rowValue
destRow = destRow + 1
rowStart = rowEnd + 1 ' reposition rowStart behind delimiter
Loop Until (rowEnd = 0 Or rowStart Len(sourceRowValue))
Next sourceRow
End Sub