How arrange from one cell to column.

[geniusideas]

Example :
Before :
Part name Qty Location (seperated by comma)
Button 1 2 B1,B2
Button 2 3 B4,B5,B6

After
Button 1 1 B1
Button 1 1 B2
Button 2 1 B4
Button 2 1 B5
Button 2 1 B6

Pls help How to do using VBA code.
For the simple as above no problem, the problem is in Excal we only
have 256 column but sometime my qty is more.
Pls help

http://microsoft-excel-macro.blogspot.com

 

[Sebation.G]

TRY: this code can get your result,but it has a defult that it will take
long time when it does with huge data.
Hope this can be helpful.
Sub test()
Dim i As Integer
Dim arr() As String
Application.ScreenUpdating = False
On Error Resume Next

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
arr = Split(Cells(i, 3), ",")
For J = 0 To UBound(arr)
With Worksheets(2)
LASTROW = .Cells(Rows.Count, 3).End(xlUp).Row + 1
.Cells(LASTROW, 1) = Cells(i, 1)
.Cells(LASTROW, 3) = arr(J)
End With
Next J
Next i
Application.ScreenUpdating = True
End Sub

 

[geniusideas]

TRY: this code can get your result,but it has a defult that it will take
long time when it does with huge data.
Hope this can be helpful.
Sub test()
Dim i As Integer
Dim arr() As String
Application.ScreenUpdating = False
On Error Resume Next

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
arr = Split(Cells(i, 3), ",")
For J = 0 To UBound(arr)
With Worksheets(2)
LASTROW = .Cells(Rows.Count, 3).End(xlUp).Row + 1
.Cells(LASTROW, 1) = Cells(i, 1)
.Cells(LASTROW, 3) = arr(J)
End With
Next J
Next i
Application.ScreenUpdating = True
End Sub

Tq, it goes to sheet 2, but i need it in same sheet, How?

 

[Sebation.G]

Sub test()
Dim i As Integer
Dim arr() As String
Application.ScreenUpdating = False
On Error Resume Next

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
arr = Split(Cells(i, 3), ",")
For j = 0 To UBound(arr)
LASTROW = Cells(Rows.Count, 6).End(xlUp).Row + 1 'change it as your
destination
Cells(LASTROW, 4) = Cells(i, 1)
Cells(LASTROW, 5) = 1
Cells(LASTROW, 6) = arr(j)

Next j
Next i
Application.ScreenUpdating = True
End Sub

hope this can be helpful

 

[geniusideas]

Sub test()
Dim i As Integer
Dim arr() As String
Application.ScreenUpdating = False
On Error Resume Next

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
arr = Split(Cells(i, 3), ",")
For j = 0 To UBound(arr)
LASTROW = Cells(Rows.Count, 6).End(xlUp).Row + 1 'change it as your
destination
Cells(LASTROW, 4) = Cells(i, 1)
Cells(LASTROW, 5) = 1
Cells(LASTROW, 6) = arr(j)

Next j
Next i
Application.ScreenUpdating = True
End Sub

hope this can be helpful

Tq very much, it works..