VBA, Parse by "|" and Transpose, Next row - vba

Question

I have the following data in a cells A1
|stack|over|flow|
and cells A2..
|today|is|friday
How can I delimit this and transpose it into a vertical/column based view view?
Delimiting will give me data row based, which is good but that I have to transpose this manually each time. I plan to do this for many rows. I realized this could be tricky as the next row will need to be pushed back down for each time.
Result A1:A6:
Stack
Over
flow
today
is
friday
Edit

Answer 1

For unlimited rows and unlimited columns:
Sub splt()
Dim str As String
Dim col As Long, rw As Long, colcnt As Long, rwcnt As Long
With Sheets("Sheet1")
colcnt = .Cells(1, .Columns.Count).End(xlToLeft).Column 'total no of columns
For col = 1 To colcnt
rwcnt = .Cells(.Rows.Count, col).End(xlUp).Row 'total no of rows for specific column
For rw = 1 To rwcnt
str = str & .Cells(rw, col)
Next rw
rw = 1
For Each Item In Split(str, "|") 'split string and display output
If Item <> "" Then
.Cells(rw, col) = Item
rw = rw + 1
End If
Next
str = ""
Next
End With
End Sub
Edit:
You can use an array for this, but the following method is less complicated to easy to write and read:
Sub splt()
Dim rw As Long, i As Long, rwcnt As Long
i = 1
With Sheets("Sheet1")
rwcnt = .Cells(.Rows.Count, 2).End(xlUp).Row 'last non-empty row number
For rw = 1 To rwcnt 'from row 1 till last non-empty row
For Each Item In Split(.Cells(rw, 2), "|") 'split the string in column 2 from "|"
If Item <> "" Then ' 'if the splitted part of the string is not empty
.Cells(i, 4) = .Cells(rw, 1) 'populate column 4 with column 1
.Cells(i, 5) = Item 'populate column 5 with splitted part of the string
.Cells(i, 6) = .Cells(rw, 3) 'populate column 6 with column 3
i = i + 1 ' increase i variable by one to be able to write the next empty row for the next loop
End If
Next 'loop to next splitted string
Next rw 'loop to next row
.Columns("A:C").EntireColumn.Delete 'when all data is extracted to Columns D-E-F, delete Columns A-B-C and your results will be in Column A-B-C now
End With
End Sub

Answer 2

This one manages an unlimited number of rows on column A
Sub go()
Dim strFoo As String
Dim LastRow As Long
Dim LastPosition As Long
Dim MySheet As Worksheet
Dim arr() As String
Dim i As Long
Dim j As Long
Set MySheet = ActiveWorkbook.ActiveSheet
MySheet.Range("A1").EntireColumn.Insert
LastRow = MySheet.Cells(MySheet.Rows.Count, "B").End(xlUp).Row
LastPosition = 1
For i = 1 To LastRow
strFoo = MySheet.Range("B" & i)
If strFoo <> "" Then
arr = Split(strFoo, "|")
For j = 0 To UBound(arr)
If arr(j) <> "" Then
MySheet.Range("A" & LastPosition) = arr(j)
LastPosition = LastPosition + 1
End If
Next j
End If
Next i
End Sub

Answer 3

You can do this with Power Query or Get & Transform
Data --> Get & Transform Data --> From Table/Range
Then in the Query Editor
Split Column by Delimiter
Use a Custom Delimiter: the Pipe |
Split at left most (to get rid of that first pipe
Remove Column 1 (the blank column)
Split Column by delimiter
Use the Advanced Option and select to split into rows
Save and you are done.