PDA

View Full Version : Solved: How modify VBA to split multiple cell?



genracela
04-07-2010, 05:50 PM
I have a code that I got from the web.

It works fine with my document since I only have Column B to split. But with the second document I have I think I need to make some modification.

My questions are:
1. What if I have to spilt multiple columns? such as G, H, I, J,K. how will I modify my VBA code below?

2. When I ran this code, the data that I split was transferred to a new worksheet. How will I modify the code if I want the data to stay at the same worksheet?

Thanks in advance!!!


Sub CellSplitter1()
Dim Temp As Variant
Dim CText As String
Dim J As Integer
Dim K As Integer
Dim L As Integer
Dim iColumn As Integer
Dim lNumCols As Long
Dim lNumRows As Long

iColumn = 2

Set wksSource = ActiveSheet
Set wksNew = Worksheets.Add

iTargetRow = 0
With wksSource
lNumCols = .Range("IV1").End(xlToLeft).Column
lNumRows = .Range("A99000").End(xlUp).Row
For J = 1 To lNumRows
CText = .Cells(J, iColumn).Value
Temp = Split(CText, Chr(10))
For K = 0 To UBound(Temp)
iTargetRow = iTargetRow + 1
For L = 1 to lNumCols
If L <> iColumn Then
wksNew.Cells(iTargetRow, L) _
= .Cells(J, L)
Else
wksNew.Cells(iTargetRow, L) _
= Temp(K)
End If
Next L
Next K
Next J
End With
End Sub

parttime_guy
04-07-2010, 07:35 PM
Dear Gen,

Can u post a sample wks.

BR

genracela
04-07-2010, 07:45 PM
File attached.

Columns G, H, I, J,K are the cells to split, since there are multiple data in one cell, I want to break each data down to single cell.

Bob Phillips
04-08-2010, 01:50 AM
Public Sub CellSplitter()
Dim i As Long, j As Long
Dim LastRow As Long
Dim vecData As Variant
Dim vecData2 As Variant
Dim vecData3 As Variant
Dim vecData4 As Variant
Dim vecData5 As Variant

Application.ScreenUpdating = False

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1

vecData = Split(.Cells(i, "J"), Chr(10))
If UBound(vecData) > LBound(vecData) Then

vecData2 = Split(.Cells(i, "K"), Chr(10))
vecData3 = Split(.Cells(i, "L"), Chr(10))
vecData4 = Split(.Cells(i, "M"), Chr(10))
vecData5 = Split(.Cells(i, "N"), Chr(10))

For j = UBound(vecData) To LBound(vecData) Step -1

If vecData(j) <> "" Then

.Rows(i + 1).Insert
.Rows(i).Copy .Cells(i + 1, "A")
.Cells(i + 1, "J").Value2 = vecData(j)
.Cells(i + 1, "K").Value2 = vecData2(j)
.Cells(i + 1, "L").Value2 = vecData3(j)
.Cells(i + 1, "M").Value2 = vecData4(j)
.Cells(i + 1, "N").Value2 = vecData5(j)

.Rows(i + 1).AutoFit
End If
Next j

.Rows(i).Delete
End If
Next i
End With

Application.ScreenUpdating = True

End Sub

genracela
04-11-2010, 08:43 PM
I tried using it, in a small file and it works, but in a large file(ex. 65000 rows) it always freeze.

:mkay