pyrte
09-15-2016, 05:01 AM
Hi guys,
I have about 10 columns filled with data and most of the columns have data entered using Alt+Enter. This shows multiple values in one cell. I need to put these in separate rows while retaining the other values in the row.
I found a macro online but this one has a restriction to validating only one column at a time that results in multiple duplicates for every time I run the macro.
Sub CellSplitter()
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 = 5
Set wksSource = ActiveSheet
Set wksNew = Worksheets.Add
iTargetRow = 0
With wksSource
lNumCols = .Range("IV1").End(xlToLeft).Column
lNumRows = .Range("A65536").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
Please let me know if anyone can help me fix this or write me a new macro that will help me solve this issue. Appreciate all the help you can offer.
I have about 10 columns filled with data and most of the columns have data entered using Alt+Enter. This shows multiple values in one cell. I need to put these in separate rows while retaining the other values in the row.
I found a macro online but this one has a restriction to validating only one column at a time that results in multiple duplicates for every time I run the macro.
Sub CellSplitter()
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 = 5
Set wksSource = ActiveSheet
Set wksNew = Worksheets.Add
iTargetRow = 0
With wksSource
lNumCols = .Range("IV1").End(xlToLeft).Column
lNumRows = .Range("A65536").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
Please let me know if anyone can help me fix this or write me a new macro that will help me solve this issue. Appreciate all the help you can offer.