Break a cell down using VBA

[daniels012]

I have Data in N2.
I looks like this:


company: High Point Care
business address: 111 North Elm St-PO HP5
High Road, AL 12345
Each line has a carriage return.
I need code to put:
company: High Point Care in cell O2
business address: 111 North Elm St-PO HP5 in cell P2
High Road, AL 12345 in cell Q2

What code can I write?
In plain english: For every carriage in active cell, move the datainto the cells to the right.


Thank You,
Michael

[GTO]

Try:

Sub exa1()
Dim ary
ary = Split(ActiveCell.Text, Chr(10))
ActiveCell.Offset(, 1).Resize(, 3).Value = ary
End Sub

[Kenneth Hobs]

Similar to GTO's:
Sub Test()
Dim a() As String

Range("N2").Value2 = "company: High Point Care" & vbCrLf & _
"business address: 111 North Elm St-PO HP5" & vbCrLf & _
"High Road, AL 12345"

a() = Split(Range("N2").Value2, vbLf)

Range("N2").Offset(0, 1).Resize(1, UBound(a) + 1).Value2 = a()
End Sub

[daniels012]

GTO,
I am going to go try right now.
Will this allow for more data if it is present?
Like:

company: High Point Care
business address: 111 North Elm St-PO HP5
High Road, AL 12345
Phone: 123-252-1245
Assistant: Tom Tommy

Thnak You for the quick responses!
Mcihael

[mancubus]

try kenneth's code:

Sub Test()
Dim a() As String

a() = Split(Range("N2").Value2, vbLf)

Range("N2").Offset(0, 1).Resize(1, UBound(a) + 1).Value2 = a()
End Sub


or GTO's code:

Sub xxxxexa1()
Dim ary
ary = Split(ActiveCell.Text, Chr(10))
ActiveCell.Offset(, 1).Resize(, 5).Value = ary
End Sub


ps: changed macro name. EXA1 is a cell address in xl2007+

[daniels012]

I don't necessarily want it tied to cell N2.
I would rather Active cell

Michael

[Kenneth Hobs]

I am not sure if you are asking for help again or stating how you will use the code.

If your are asking for a change, or you decide to change again, try:
Sub Test_SplitToRightByVBLF()
Range("N2").Value2 = "company: High Point Care" & vbCrLf & _
"business address: 111 North Elm St-PO HP5" & vbCrLf & _
"High Road, AL 12345"
Range("N2").Select
SplitToRightByVBLF ActiveCell
End Sub

Sub SplitToRightByVBLF(aRange As Range)
Dim a() As String
If aRange.Count <> 1 Then Exit Sub
a() = Split(aRange.Value2, vbLf)
aRange.Offset(0, 1).Resize(1, UBound(a) + 1).Value2 = a()
End Sub

[daniels012]

Kenneth,
Actually I was asking for help,
Here is what I use and it works well.
Dim a() As String

a() = Split(ActiveCell.Value2, vbLf)

ActiveCell.Offset(0, 1).Resize(1, UBound(a) + 1).Value2 = a()

Now is there an easy way to do this on down the column. Do this function starting at the active cell on down. Because I am not always in N2 or I might start further down, say cell "P8"

Thank You for your help so far,
Michael

[mancubus]

modified for all values in column A.


Sub Test()

Dim a() As String
Dim rww As Long, LR As Long

'for data in column 1, ie "A". change to suit.
LR = Cells(Rows.Count, 1).End(xlUp).Row

For rww = 1 To LR 'change 1 to starting row number
a() = Split(Range("A" & rww).Value2, vbLf)
Range("A" & rww).Offset(0, 1).Resize(1, UBound(a) + 1).Value2 = a()
Next

End Sub

[daniels012]

I get an error 400?

I think I changed everything correctly.
I am starting in cell CK2 on down

MIchael

[daniels012]

OK,
I kinda figured it out. When the cell is blank, it gives the error. As soon as I add any test in the blank cells it works.

SO, maybe add an if <>"" then cycle through the code. Or if blank go to the next.
See my extent of VBA knowledge! LOL!
Michael

[Kenneth Hobs]

Sub Test_SplitToRightByVBLF()
Dim cell As Range
For Each cell In Range("N2", Range("N" & Rows.Count).End(xlUp))
If cell.Value2 <> Empty Then SplitToRightByVBLF cell
Next cell
End Sub

Sub SplitToRightByVBLF(aRange As Range)
Dim a() As String
If aRange.Count <> 1 Then Exit Sub
a() = Split(aRange.Value2, vbLf)
aRange.Offset(0, 1).Resize(1, UBound(a) + 1).Value2 = a()
End Sub