How arrange from one cell to column.

G

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
 
S

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
 
G

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?
 
S

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
 
G

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..
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top