New row after every comma ","

[Guest]

Hi...

Ive got a small problem that i just cant get working good. Ive got a
workbook with about 15 columns and 1000 rows. In column D there are numbers
seperated with a comma. Here is an example of my sheet:

A B C D

test1 red 50 3,5,23,67,56,23,4
test2 blue 60 5,6,87,54,98
test3 orange 40 7,87,52,16

etc.etc

The numbers in column D are refering to other rows (predecessors in
projects). What i want is to insert an extra row for every number. My output
will look like this:

A B C D

test1 red 50 3
5
23
67
56
23
4
test2 blue 60 5
6
87
54
98
test3 orange 40 7
87
52
16

etcetc.

Can anybody help me out with this.... thanks in advance!!!

 

[Dave Peterson]

You could use a macro:

Option Explicit
Sub testme()
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim wks As Worksheet
Dim mySplit As Variant
Dim HowMany As Long

Set wks = Worksheets("sheet1")

With wks
FirstRow = 1 'no headers?
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
mySplit = Split(.Cells(iRow, "D").Value, ",")
HowMany = UBound(mySplit) - LBound(mySplit) + 1
.Rows(iRow + 1).Resize(HowMany - 1).Insert
.Cells(iRow, "D").Resize(HowMany, 1).Value _
= Application.Transpose(mySplit)
Next iRow
End With

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

 

[Guest]

Hello Dave,

I installed your macro but it gives error 1004 (Application-defined or
object-defined error) on this line:

..Rows(iRow + 1).Resize(HowMany - 1).Insert

Thanks in advance for helping me

 

[Dave Peterson]

Maybe you have entries with only one element (or no elements) in that column?

Option Explicit
Sub testme()
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim wks As Worksheet
Dim mySplit As Variant
Dim HowMany As Long

Set wks = Worksheets("sheet1")

With wks
FirstRow = 1 'no headers?
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
If InStr(1, .Cells(iRow, "D").Value, ",", vbTextCompare) > 0 Then
mySplit = Split(.Cells(iRow, "D").Value, ",")
HowMany = UBound(mySplit) - LBound(mySplit) + 1
.Rows(iRow + 1).Resize(HowMany - 1).Insert
.Cells(iRow, "D").Resize(HowMany, 1).Value _
= Application.Transpose(mySplit)
End If
Next iRow
End With

End Sub

 

[Guest]

Hello Dave,

I do have elements with no entry.... the new macro works perfect thanks a
lot for helping and sorry i didnt told about the blanks....

TooN

 

[Dave Peterson]

Glad it works.

Hello Dave,

I do have elements with no entry.... the new macro works perfect thanks a
lot for helping and sorry i didnt told about the blanks....

TooN