Split multiple columns into rows by a delimiter - vba

Question

I have two columns which have delimiters. Both columns will have the same number of delimiters. e.g a;b;c in column A and d;e;f in column B. In some columns there might not be any which is fine.
I want to be able split these columns into the exact number of rows and copy data from other columns as well. Therefore, the example above would have a total of 3 rows and result as below:
Col A Col B
a d
b e
c f
I have found the code below which i modified and works for a specified column but I want to apply this to multiple columns if possible.
Option Explicit
Sub splitcells()
Dim InxSplit As Long
Dim SplitCell() As String
Dim RowCrnt As Long
With Worksheets("Sheet1")
RowCrnt = 1
Do While True
If .Cells(RowCrnt, "L").Value = "" Then
Exit Do
End If
SplitCell = Split(.Cells(RowCrnt, "L").Value, "*")
If UBound(SplitCell) > 0 Then
.Cells(RowCrnt, "L").Value = SplitCell(0)
For InxSplit = 1 To UBound(SplitCell)
RowCrnt = RowCrnt + 1
.Rows(RowCrnt).EntireRow.Insert
.Cells(RowCrnt, "L").Value = SplitCell(InxSplit)
.Cells(RowCrnt, "A").Value = .Cells(RowCrnt - 1, "A").Value
.Cells(RowCrnt, "B").Value = .Cells(RowCrnt - 1, "B").Value
.Cells(RowCrnt, "C").Value = .Cells(RowCrnt - 1, "C").Value
.Cells(RowCrnt, "D").Value = .Cells(RowCrnt - 1, "D").Value
.Cells(RowCrnt, "E").Value = .Cells(RowCrnt - 1, "E").Value
.Cells(RowCrnt, "F").Value = .Cells(RowCrnt - 1, "F").Value
.Cells(RowCrnt, "G").Value = .Cells(RowCrnt - 1, "G").Value
.Cells(RowCrnt, "H").Value = .Cells(RowCrnt - 1, "H").Value
.Cells(RowCrnt, "I").Value = .Cells(RowCrnt - 1, "I").Value
.Cells(RowCrnt, "J").Value = .Cells(RowCrnt - 1, "J").Value
.Cells(RowCrnt, "K").Value = .Cells(RowCrnt - 1, "K").Value
Next
End If
RowCrnt = RowCrnt + 1
Loop
End With
End Sub
Is this possible? Any help is greatly appreciated.

Answer 1

Hello, took me a while, but I actually found a pretty fascinating / useful little procedure in this, so i was playing around a bit.
I've created a little procedure which, where you can specify from which column you want to take the data, and into which column you want to paste the data. With the following invocation:
The parse_column procedure is coded with the following way:
' parses all the values into an array
Private Sub parse_column(columnID As Integer, toColumn As Integer)
Dim totalstring As String
Dim lastrow As Integer
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'change to whatever sheet you are working with
Dim startingrow As Integer
startingrow = 2 'change to whatever row you want the procedure to start from _
(i skipped first row, because it acts as a header)
With ws
lastrow = .Cells(.Rows.Count, columnID).End(xlUp).Row
End With
Dim columnrange As Range: Set columnrange = Range(Cells(startingrow, columnID), Cells(lastrow, columnID))
For Each Rng In columnrange
totalstring = totalstring + Trim(Rng) ' we'll concatenate all the column values into a one string _
(if you wish to take spaces into accoumt, don't use trim)
Next Rng
Dim buffer() As String
ReDim buffer(Len(totalstring) - 1) '(avoid indexation by 0)
For i = 1 To Len(totalstring)
buffer(i - 1) = Mid(totalstring, i, 1) 'we fill in buffer with values
Next i
' we paste values to specified column
For i = (LBound(buffer)) To UBound(buffer)
ws.Cells((i + startingrow), toColumn).Value2 = buffer(i)
Next i
End Sub
So for example, if you wanted to parse all data from Column 1 (A) to Column 4 (D) you would invoke it in your procedure the following way
Private Sub splitcells()
Call parse_column(1, 4)
End Sub
Beauty of this all is, you can simply loop this for all the columns you have in your sheet by a simple static for loop increment. So for example, if we had 3 columns:
Let's presume we have the following data:
^ Note how Column C doesn't even have to be limited to 3 characters
We could use a simple for loop to loop through all 3 columns and paste them to the 4th next column to the right.
Private Sub splitcells()
Dim i As Integer
For i = 1 To 3
Call parse_column(i, (i + 4))
Next i
End Sub
Would produce the following result: