Divide Cell Across Rows

[dee]

Hello,

For example, I have 3 cells across by one row down and the first two contain
data that is separated by Ctrl + Enter:

Column: A B D

Row:
1 Dog X 100
1 Cat Y
1 Mouse Z

I am trying to fnd a way to split the data across 3 separate rows, in this
example, as such:

Column: A B C
Row:

1 Dog X 100
2 Cat Y 100
3 Mouse Z 100

The data may sometimes be separated by another character, such as ; or ,

In an ideal world, I would love for the user to input which character or
characters are the dividing character, but if this is too difficult, then I
could simply provide different macros for different characters.

Also, I don't want specific columns to be referred to, as the layout and
column position of these items may change from file to file. Basically, for
them to select the column(s) they wish to divide.

Any help at all in this problem would be greatly appreciated.
Thank you.

 

[Tom Ogilvy]

Sub SplitData()
Dim rng As Range
Set rng = Selection(1).Resize(1, 3)
rng(1, 1).Resize(3, 1).Value = Application.Transpose(Split(rng(1, 1),
Chr(10)))
rng(1, 2).Resize(3, 1).Value = Application.Transpose(Split(rng(1, 2),
Chr(10)))
rng(1, 3).Resize(3, 1).Value = rng(1, 3).Value
End Sub

worked on your sample data.

 

[dee]

Hi there and thanks so much.

I tried this, but keep getting a syntax error.

 

[Tom Ogilvy]

Probably because of wordwrap caused by the email:

Sub SplitData()
Dim rng As Range
Set rng = Selection(1).Resize(1, 3)
rng(1, 1).Resize(3, 1).Value = _
Application.Transpose(Split(rng(1, 1), Chr(10)))
rng(1, 2).Resize(3, 1).Value = _
Application.Transpose(Split(rng(1, 2), Chr(10)))
rng(1, 3).Resize(3, 1).Value = rng(1, 3).Value
End Sub

 

[dee]

Hi Tom,

I suspected it was the word wrap.. Thank you so much for your help.

I ran the code and it worked for the first cell. I ran into trouble,
though, when either the cell had 2 or 4 (something other than 3) entries in
the cell and also when the same line in the cell next to it contained no
data, but rather just the Alt+Enter as there was no quantity. Example:

Dog
Cat 100
Zebra
Lion 45

Perhaps I'm asking for the impossible!

Thanks again, Tom. I have to tell you that I have used some of your
suggestions in other posts and they worked so well!

Kind regards,
Dee

 

[Tom Ogilvy]

Maybe something like this:

Sub SplitData()
Dim rng As Range, cell As Range
Dim rng1 As Range
Dim maxCell As Long
Dim sz As Long, v As Variant
maxCell = 1
For Each cell In Selection
If InStr(1, cell, Chr(10), vbTextCompare) Then
v = Split(cell, Chr(10))
sz = UBound(v) - LBound(v) + 1
If sz > maxCell Then maxCell = sz
cell.Resize(sz, 1).Value = Application.Transpose(v)
Else
If rng1 Is Nothing Then
Set rng1 = cell
Else
Set rng1 = Union(rng1, cell)
End If
End If
Next
If Not rng1 Is Nothing Then
For Each cell In rng1
cell.Resize(maxCell, 1).Value = cell
Next
End If
End Sub

Hard to tell without knowing all the possibilities.

--
Regards,
Tom Ogilvy

Hi Tom,

I suspected it was the word wrap.. Thank you so much for your help.

I ran the code and it worked for the first cell. I ran into trouble,
though, when either the cell had 2 or 4 (something other than 3) entries
in
the cell and also when the same line in the cell next to it contained no
data, but rather just the Alt+Enter as there was no quantity. Example:

Dog
Cat 100
Zebra
Lion 45

Perhaps I'm asking for the impossible!

Thanks again, Tom. I have to tell you that I have used some of your
suggestions in other posts and they worked so well!

Kind regards,
Dee

 

[dee]

Hi Tom,

Thanks again. I tried this code and it worked to a degree, however, if I
only have 1 or 3 entries in a cell, it copies that entry to the next row down
and replaces what was there. If there are 2 entries, it separates the 2
entries properly, but then replaces the data in the 3rd row down with #N/A...

Any ideas why that would happen?