Separating a comma separated list

[draco664]

Not having a great deal of experience with macros, I thought I might
see if I could pick the brains of the group.

I have to essentially break out a comma separated text string in a
single cell into a vertical list, with a reference number thrown in
for good measure.

Example.

Data I have:
A B
1 NUMBER RESOURCE
2 101 Smith John,Jones Adam,Brown Philip,Greene Thomas
3 102 Smith John,Jackson Arthur

Needs to look like:
A B
1 NUMBER RESOURCE
2 101 Smith John
3 101 Jones Adam
4 101 Brown Philip
5 101 Greene Thomas
6 102 Smith John
7 102 Jackson Arthur

The resources will be copied into Excel from Project on a weekly
basis, so I was after some ideas on how to make a macro that would
separate the text out.

Any ideas?

Chris

 

[kounoike]

How about this one? I assumed data start at A2

Sub splitdatatest()
Dim pcell As Range, tcell As Range
Dim n As Long
Dim res

Set pcell = Cells(2, 1) '<=== change here
Set tcell = pcell.Offset(1, 0)

Application.ScreenUpdating = False

Do While (Not IsEmpty(pcell))
res = Split(pcell.Offset(0, 1), ",")
n = UBound(res)
If n > 0 Then
tcell.Resize(n, 1).EntireRow.Insert
pcell.Offset(1, 0).Resize(n, 1) = pcell.Value
pcell.Offset(0, 1).Resize(n + 1, 1) = _
Application.Transpose(res)
End If
Set pcell = tcell
Set tcell = pcell.Offset(1, 0)
Loop
End Sub

keizi

 

[Guest]

Hi,

I put some code together and by the time I finished I see you already have a
reply. However I will post my code also and you then have a choice.

The code parses the comma separated values using Text to Columns and then
copies the data and transposes to another worksheet. It then copies the
Number field.

Sub Macro2()
Dim wsSht1 As Worksheet
Dim wsSht2 As Worksheet
Dim rngColB As Range
Dim rngRows As Range
Dim rngDest As Range
Dim c As Range

Set wsSht1 = Sheets("Sheet1")
Set wsSht2 = Sheets("Sheet2")

wsSht1.Select
Columns("B:B").TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, _
Comma:=True

wsSht2.Range("A1") = "NUMBER"
wsSht2.Range("B1") = "RESOURCE"

With wsSht1
Set rngColB = Range(.Cells(2, 2), _
.Cells(.Rows.Count, 2).End(xlUp))
End With

With wsSht1
For Each c In rngColB
Set rngRows = Range(c, .Cells(c.Row, _
.Columns.Count).End(xlToLeft))
Set rngDest = wsSht2.Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0)
rngRows.Copy
rngDest.PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
c.Offset(0, -1).Copy _
Destination:=rngDest.Offset(0, -1) _
.Resize(rngRows.Columns.Count, 1)
Next c
End With
wsSht2.Select
Range("A1").Select
End Sub

Regards,

OssieMac

 

[draco664]

Hi,

I put some code together and by the time I finished I see you already have a
reply. However I will post my code also and you then have a choice.

The code parses the comma separated values using Text to Columns and then
copies the data and transposes to another worksheet. It then copies the
Number field.

Sub Macro2()
Dim wsSht1 As Worksheet
Dim wsSht2 As Worksheet
Dim rngColB As Range
Dim rngRows As Range
Dim rngDest As Range
Dim c As Range

Set wsSht1 = Sheets("Sheet1")
Set wsSht2 = Sheets("Sheet2")

wsSht1.Select
Columns("B:B").TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, _
Comma:=True

wsSht2.Range("A1") = "NUMBER"
wsSht2.Range("B1") = "RESOURCE"

With wsSht1
Set rngColB = Range(.Cells(2, 2), _
.Cells(.Rows.Count, 2).End(xlUp))
End With

With wsSht1
For Each c In rngColB
Set rngRows = Range(c, .Cells(c.Row, _
.Columns.Count).End(xlToLeft))
Set rngDest = wsSht2.Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0)
rngRows.Copy
rngDest.PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
c.Offset(0, -1).Copy _
Destination:=rngDest.Offset(0, -1) _
.Resize(rngRows.Columns.Count, 1)
Next c
End With
wsSht2.Select
Range("A1").Select
End Sub

Regards,

OssieMac

Wow, thanks to both of you. I really appreciate it. I'll try both and
see which works best.

Thanks again.

Chris