New row after every comma

[TooN]

Hello,

can anybody help me out with this problem. I have a sheet with about 15
columns and 100 rows. I would like to insert an extra row after the comma in
column D. My sheet looks 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

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

Can anybody help me out??? Thanks

 

[Dave Peterson]

See your first post.

Hello,

can anybody help me out with this problem. I have a sheet with about 15
columns and 100 rows. I would like to insert an extra row after the comma in
column D. My sheet looks 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

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

Can anybody help me out??? Thanks

 

[Zone]

Too, How about this? Backup your file first just in case. Then reopen
the original file, copy this code, put it in a standard module and run
it. James

Sub SplitColD()
Dim k As Integer, m As Long, tempStr As String
For m = Cells(65536, "a").End(xlUp).Row To 1 Step -1
If Cells(m, "d") <> "" Then
For k = Len(Cells(m, "d")) To 1 Step -1
If Mid(Cells(m, "d"), k, 1) = "," Then
Rows(m + 1).EntireRow.Insert
Cells(m + 1, "d") = tempStr
tempStr = ""
Else
tempStr = Mid(Cells(m, "d"), k, 1) & tempStr
End If
Next k
tempStr = ""
For k = 1 To Len(Cells(m, "d"))
If Mid(Cells(m, "d"), k, 1) = "," Then
Cells(m, "d") = tempStr
tempStr = ""
Exit For
Else
tempStr = tempStr & Mid(Cells(m, "d"), k, 1)
End If
Next k
End If
Next m
End Sub

 

[TooN]

Hello Zone,

I installed the macro and got it running. There is only one smaal problem.
Sometimes the macro copies a value from the cell under the specified row and
copies that into the cell above. Example of my output:

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

As you can see in test 1, the last number has to be 4 but it copies the next
cell as well. In test 2 it says 987, this has got to be 98. The seven is
copied wrong??

Thanks in advance for helping me out. If you need more detail about the
problem let me know!

TooN

 

[Zone]

TooN, I could not recreate the problem. But I did clean up the code.
Try this in place of the original code. Let me know if it fixes the
problem! James

Sub SplitColD()
Dim k As Integer, m As Long, tempStr As String
tempStr=""
For m = Cells(65536, "a").End(xlUp).Row To 1 Step -1
If Cells(m, "d") <> "" Then
For k = Len(Cells(m, "d")) To 1 Step -1
If Mid(Cells(m, "d"), k, 1) = "," Then
Rows(m + 1).EntireRow.Insert
Cells(m + 1, "d") = tempStr
tempStr = ""
Else
tempStr = Mid(Cells(m, "d"), k, 1) & tempStr
End If
Next k
Cells(m, "d") = tempStr
tempStr = ""
End If
Next m
End Sub

 

[TooN]

It works.... thanks, you saved me a lot of time