Divide contents of cell

[C. Roy Blye]

Hi,

I would like to write a macro that divides the contents of one cell into two
separate cells.

For example: If a cell contains "cats & dogs", I would like to convert the
contents of the cell into two cells, one containing "cats" and the other
containing "dogs". (The quotes are not part of the actual contents.)

My feeble attempt to create a macro for this always results in "cats" and
"dogs", even when the original cell contains "horses & cows". In other
words, I need a macro that isn't so "literal".

As you may have guessed, my macro was created by recording it, rather than
writing it from scratch. (I admit to being a novice at this.)

I can see where the problem is in the code, but I don't know how to fix it.
For example, this line from the code:

Range("A2").Select
ActiveCell.FormulaR1C1 = "cats"

needs to say something like:

Range("A2").Select
ActiveCell.FormulaR1C1 = "string to left of & sign"

Thanks in advance for any help.

Roy

PS If there is a more appropriate newsgroup for this question, please let me
know.

 

[Tom Ogilvy]

Assumes the divider as an Ampersand:

Sub EFG()
Dim s As String, s1 As String, s2 As String
Dim iloc As Long
s = ActiveCell.Value
iloc = InStr(1, s, "&", vbTextCompare)
If iloc <> 0 Then
s1 = Trim(Left(s, iloc - 1))
s2 = Trim(Right(s, Len(s) - iloc))
ActiveCell.Offset(0, 1) = s1
ActiveCell.Offset(0, 2) = s2
Else
ActiveCell.Offset(0, 1).Value = s
End If
End Sub

 

[Don Guillett]

You can use data>text to columns to divide and then delete the & column

or

Sub separatecell()
For Each c In Selection
x = InStr(c, "&")
c.Offset(, 1) = Right(c, Len(c) - x)
c.Value = Left(c, x - 2)
Next c
End Sub

 

[Gary Keramidas]

here's another approach that may work. i assumed the data is in column A

Sub test()
Dim i As Long, lastrow As Long
Dim str As Variant
Dim cell As Range
i = 0
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In Range("A1:A" & lastrow)
str = Split(cell.Value, "&")
cell.Offset(, 1) = Trim(str(i))
cell.Offset(, 2) = Trim(str(i + 1))
Next
End Sub

 

[C. Roy Blye]

Hi Tom,

It works! I'm very impressed! Wanna trade brains?

Thanks very much!
Roy

 

[C. Roy Blye]

Hi Don,

You're a genius! Just what I was looking for. Not that I will ever know what
you know, but can you recommend a source (book, website, etc.) to get me
started?

Thanks very much for your help!
Roy

PS I'm intrigued that your method and Tom's method (above) are so
different, but both work well. Is that what they mean when they say "There's
more than one way to skin a cat?"

 

[C. Roy Blye]

Hi Gary,

When I ran the macro, it gave me a "Run-time error '9': Subscript out of
range" error message.
I certainly appreciate your help, but please don't bust a neuron
troubleshooting your macro - the above two macros work very well and I can
use either of those.

Thanks,
Roy

 

[Bob Phillips]

Probably because there are items withiout an &

Sub test()
Dim i As Long, lastrow As Long
Dim str As Variant
Dim cell As Range
i = 0
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In Range("A1:A" & lastrow)
str = Split(cell.Value, "&")
cell.Offset(, 1) = Trim(str(i))
If LBound(str) <> UBound(str) Then
cell.Offset(, 2) = Trim(str(i + 1))
End If
Next
End Sub



--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Gary Keramidas]

you probably had some blank cells and i didn't test for that