Excel VBA: Transpose different parts of a string - vba

Question

I have values that are horizontally in cells next to each other. In each cell, I'm extracting a certain substring of the cell and want to transpose each part vertically in certain columns.
Example:
ColA ColB ColC
First.Second<Third> Fourth.Fifth<Sixth> Seventh.Eighth<Ninth>
Should look like on a new worksheet (ws2):
ColA ColB ColC
First Second Third
Fourth Fifth Sixth
Seventh Eighth Ninth
I tried looping over rows and columns, but that skipped randomly
For i = 2 to lastRow
lastCol = ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column
For j = 2 to lastCol
cellVal = ws.Cells(i, j).Value
firstVal = Split(cellVal, ".")
secondVal = 'extract second val
thirdVal = 'extract third val
ws2.Cells(i,1).Value = firstVal
ws2.Cells(i,2).Value = secondVal
ws3.Cells(i,4).Value = thirdVal
EDIT: Updated almost working code below:
Sub transPose()
Dim used As Range
Set used = Sheet1.UsedRange 'make better constraint if necessary
Dim cell As Range
Dim arr(0 To 3) As String
Dim str As String
Dim pointStr As Variant, arrowSplit As Variant
Dim rowCount As Long
rowCount = 0
For Each cell In used 'This goes across rows and then down columns
str = Trim(cell.Value2)
If str <> "" Then 'Use better qualification if necessary
spaceStr = Split(str, " ")
arr(0) = spaceStr(0)
arr(1) = spaceStr(1)
arrowSplit = Split(spaceStr(1), "<")
arr(2) = LCase(Mid(str, Application.Find("<", str) + 1, 1)) & LCase(arrowSplit(0))
openEmail = InStr(str, "<")
closeEmail = InStr(str, ">")
arr(3) = Mid(str, openEmail + 1, closeEmail - openEmail - 1)
rowCount = rowCount + 1
Sheet2.Cells(1 + rowCount, 1).Resize(1, 4).Value = arr
End If
Next cell
End Sub
EDIT2: Data actually looks like
ColA ColB etc...
John Smith<John.Smith#google.com> Jane Doe<Jane.Doe#google.com>
And Should look like:
ColA ColB ColC ColD
John Smith jsmith john.smith#google.com
Jane Doe jdoe jane.doe#google.com

Answer 1

Try this:
Sub transPose()
Dim used As Range
Set used = Sheet1.UsedRange 'make better constraint if necessary
Dim cell As Range
Dim arr(0 To 2) As String
Dim str As String
Dim pointStr As Variant, arrowSplit As Variant
Dim rowCount As Long
rowCount = 0
For Each cell In used 'This goes across rows and then down columns
str = cell.Value2
If str <> "" Then 'Use better qualification if necessary
pointStr = Split(str, ".")
arr(0) = pointStr(0)
arrowSplit = Split(pointStr(1), "<")
arr(1) = arrowSplit(0)
arr(2) = Split(arrowSplit(1), ">")(0)
rowCount = rowCount + 1
Sheet2.Cells(1 + rowCount, 1).Resize(1, 3).Value = arr
End If
Next cell
End Sub

Answer 2

For each input row, you will have 3 output rows, meaning you increment the output row by 3 for each input row. Additionally, the Cells function takes (row, col) parameters.
The math becomes goofy if you're iterating i and j from the start row/col to the last row/col, so I suggest instead iterating over the count of rows/cols and using a starting point for reference, either a cell stored as a Range object or the start row/col.
For i = 0 to ws.Rows.Count
For j = 0 to ws.Columns.Count
cellVal = ws.Cells(i + startRow, j + startCol).Value
firstVal = Split(cellVal, ".")
secondVal = 'extract second val
thirdVal = 'extract third val
ws2.Cells((i*3) + startRow, j + startCol).Value = firstVal
ws2.Cells((i*3) + 1 + startRow, j + startCol).Value = secondVal
ws3.Cells((i*3) + 2 + startRow, j + startCol).Value = thirdVal
Etc...
In fact, if I were doing this, I would probably just make inputRange and outputRange parameters of the function and then just iterate through those. It would simplify both the iteration (no need for the messy startRow or startCol) and the indexing. If you are looking for that sort of solution, drop a comment and I can add it.

Answer 3

edited after OP's edited question
you could try this:
Sub main2()
Dim cell As Range, row As Range
Dim arr As Variant
Dim finalValues(1 To 4) As String
Dim iRow As Long
Dim ws As Worksheet, ws2 As Worksheet
Set ws = Worksheets("originalData") '<--| change "originalData" to your actual sheet name with starting data
Set ws2 = Worksheets("results") '<--| change "results" to your actual sheet name with starting data
For Each row In ws.UsedRange.Rows
For Each cell In row.SpecialCells(xlCellTypeConstants)
arr = Split(Replace(Replace(cell.Value, "<", " "), ">", ""), " ")
finalValues(1) = arr(0): finalValues(2) = arr(1): finalValues(3) = Left(arr(0), 1) & arr(1): finalValues(4) = arr(2)
iRow = iRow + 1
ws2.Cells(iRow, 1).Resize(, UBound(finalValues)).Value = finalValues
Next
Next
End Sub