How arrange from one cell to column.

  • Thread starter Thread starter geniusideas
  • Start date Start date
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
 
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
 
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
Click to expand...


Tq, it goes to sheet 2, but i need it in same sheet, How?
 
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
 
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
Click to expand...

Tq very much, it works..
 
Back
Top