Separate data to multiple columns

[dhaderle]

I have a large amount of data that I'd like to convert.

Current set-up in one column is such:

Snooker, John
Project A
Project B
Cowhill, Kim
Project Q
Project T
Project F

I would like to separate the Name and Projects into separate columns:

Column A Column B
Snooker, John Project A
Snooker, John Project B
Cowhill, Kim Project Q
Cowhill, Kim Project T
Cowhill, Kim Project F

How do I do this either programatically or via formula.

 

[geolefty]

I am sure there is an easier way but how about this.

Starting with your original data in column A1. Make a Copy and put in in column B.

Apply autofilter to the 2 columns (data: filter: autofilter)

In column A use a custom filter (contains "project"). Select those cells in that column and delete them.

Set the autofilter to show all. You should just have names in column A now.

In column B use a custom filter (does not contain "project"). Select those cells in that column and delete them.

Set the autofilter to show all. You should just have projects in column B now.

Now select all the names a range starting with the first name in column A and all the rest of the names in the column and press f5. Select special: blanks (click ok). All of the blanks should be highlighted. Type =a1 and then press control enter. ***A1 should be the cell where the first name is located***

Select column A and copy paste special values.

Autofilter column B again deleting the blanks.

Then in column C type =concatenate(a1," ",b1)

Column C should be what you were looking for. You can copy: paste special: values and should be good to go.

But I am sure someone could do this better faster stronger.

HTH.

geo

 

[tactps]

Or via VBA:

Select the cells you want to use before running this.

Sub macro()
Dim cell As Range
For Each cell In Selection
If Left(cell.Text, 4) <> "Proj" Then
Name = cell.Text
Else
cell.Offset(0, 1).Formula = cell.Text
cell.Formula = Name
End If
Next cell
For Each cell In Selection
If cell.Offset(0, 1).Text = "" Then cell.EntireRow.Delete
Next cell
End Sub

 

[dhaderle]

Sorry I needed to be a bit more clearer. Not all the Project's are named the same e.g. Project A, B, or C or start with the word Project. One project name could be Elephant, the second could be called Zebra, third is Tiger, and, and, and....

 

[geolefty]

tactps - I knew there would be an easier way.

dhaderle - mine is still archaic but might be able to modify pretty quickly

ASSUMING that all of the names will have a comma and all of the projects will NOT have a comma make these adjustments.

On column A, use the custom autofilter (contains ",")
On column B, use the custom autofilter (does not contain ",")

(both without quotes)

HTH

 

[tactps]

To use my method, you will need to define how we can tell the difference between a name and a project.

Otherwise, geo's solution will work.

 

[Nimrod]

Sub RearrangeProjects()
For Each c In Columns("A:A").SpecialCells(xlCellTypeConstants, 2)
If InStr(1, c.Value, ",") > 0 Then
Nam = c.Value
Else
c.Offset(0, 2).Value = c.Value
c.Offset(0, 1).Value = Nam
End If
Next c
Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Columns("A:A").Delete Shift:=xlToLeft
End Sub

:-> ASSUMPTIONs:
All names have a comma in them
All information is in Col A
column B and C and empty
values in col A are constants