On-screen guidance at the moment of need enables you & your employees to focus on the core, you can now boost your adoption rates swiftly and simply with one easy tool.
Private wsSplit As Worksheet
Public Sub SplitToSingleRows()
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.Sheets("Before")
wsSource.Copy After:=wsSource
Set wsSplit = ActiveSheet
SplitByColumn 2
SplitByColumn 4
SplitByColumn 6
SplitByColumn 8
End Sub
Private Sub SplitByColumn(iColumn As Integer)
Dim i As Integer
Dim iLastRow As Integer
Dim sCellValue As String
iLastRow = wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Row
i = 2 ' Start from row 2, missing headers
While i <= iLastRow
sCellValue = wsSplit.Cells(i, iColumn).Value
If InStr(1, sCellValue, vbLf) > 0 Then
' This row needs to be split
SplitRow i
iLastRow = iLastRow + 1
End If
i = i + 1
Wend
End Sub
Private Sub SplitRow(iRow As Integer)
Dim i As Integer
Dim sCellValue As String
Dim iSplitPos As Integer
With wsSplit
.Rows(iRow).Insert
For i = 1 To wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Column
sCellValue = wsSplit.Cells(iRow + 1, i).Value
iSplitPos = InStr(1, sCellValue, vbLf)
If iSplitPos > 0 Then
' Split this cell
wsSplit.Cells(iRow, i).Value = Left(sCellValue, iSplitPos - 1)
wsSplit.Cells(iRow + 1, i).Value = Mid(sCellValue, iSplitPos + 1)
Else
wsSplit.Cells(iRow, i).Value = sCellValue
End If
Next
End With
End Sub
Private wsSplit As Worksheet
Public Sub SplitToSingleRows()
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.Sheets("Before")
wsSource.Copy After:=wsSource
Set wsSplit = ActiveSheet
SplitByColumn 2
SplitByColumn 4
SplitByColumn 6
SplitByColumn 8
End Sub
Private Sub SplitByColumn(icolumn As Integer)
Dim i As Integer
Dim iLastRow As Integer
Dim sCellValue As String
iLastRow = wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Row
i = 2 ' Start from row 2, missing headers
While i <= iLastRow
sCellValue = wsSplit.Cells(i, icolumn).Value
If InStr(1, sCellValue, vbLf) > 0 Then
' This row needs to be split
SplitRow i, icolumn
iLastRow = iLastRow + 1
End If
i = i + 1
Wend
End Sub
Private Sub SplitRow(iRow As Integer, icolumn As Integer)
Dim i As Integer
Dim sCellValue As String
Dim iSplitPos As Integer
With wsSplit
.Rows(iRow).Insert
For i = 1 To wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Column
sCellValue = wsSplit.Cells(iRow + 1, i).Value
If (i = icolumn) Or (i = icolumn + 1) Then
iSplitPos = InStr(1, sCellValue, vbLf)
If iSplitPos > 0 Then
' Split this cell
wsSplit.Cells(iRow, i).Value = Left(sCellValue, iSplitPos - 1)
wsSplit.Cells(iRow + 1, i).Value = Mid(sCellValue, iSplitPos + 1)
End If
Else
wsSplit.Cells(iRow, i).Value = sCellValue
End If
Next
End With
End Sub
Private wsSplit As Worksheet
Public Sub LSP_split()
Dim wsSource As Worksheet
Set wsSource = ActiveSheet
wsSource.Copy After:=wsSource
Set wsSplit = ActiveSheet
SplitByColumn 18
SplitByColumn 20
SplitByColumn 24
SplitByColumn 26
SplitByColumn 28
SplitByColumn 32
SplitByColumn 34
SplitByColumn 36
SplitByColumn 38
SplitByColumn 40
SplitByColumn 42
SplitByColumn 44
SplitByColumn 46
SplitByColumn 48
SplitByColumn 50
SplitByColumn 52
SplitByColumn 54
SplitByColumn 56
SplitByColumn 58
SplitByColumn 60
SplitByColumn 63
SplitByColumn 65
SplitByColumn 67
SplitByColumn 71
SplitByColumn 72
SplitByColumn 74
SplitByColumn 77
SplitByColumn 79
End Sub
Private Sub SplitByColumn(iColumn As Integer)
Dim i As Integer
Dim iLastRow As Integer
Dim sCellValue As String
iLastRow = wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Row
i = 2 ' Start from row 2, missing headers
While i <= iLastRow
sCellValue = wsSplit.Cells(i, iColumn).Value
If InStr(1, sCellValue, vbLf) > 0 Then
' This row needs to be split
SplitRow i
iLastRow = iLastRow + 1
End If
i = i + 1
Wend
End Sub
Private Sub SplitRow(iRow As Integer)
Dim i As Integer
Dim sCellValue As String
Dim iSplitPos As Integer
With wsSplit
.Rows(iRow).Insert
For i = 1 To wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Column
sCellValue = wsSplit.Cells(iRow + 1, i).Value
iSplitPos = InStr(1, sCellValue, vbLf)
If iSplitPos > 0 Then
' Split this cell
wsSplit.Cells(iRow, i).Value = Left(sCellValue, iSplitPos - 1)
wsSplit.Cells(iRow + 1, i).Value = Mid(sCellValue, iSplitPos + 1)
Else
wsSplit.Cells(iRow, i).Value = sCellValue
End If
Next
End With
End Sub
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Excel formula to return X:Y axis in a cell | 6 | 27 | |
Records from Access to Excel to specific cells | 5 | 29 | |
Efficient way to copy unique records from one sheet to another | 5 | 22 | |
formula to count the number of capital letters in an excel formula | 3 | 18 |
Join the community of 500,000 technology professionals and ask your questions.