How to separate and transpose row in excel? [duplicate] - excel

Question

This question already has answers here:
How to Split a single cell into multiple rows and add another row
(3 answers)
Closed 5 years ago.
I have excel sheet with two columns, the first column contains contain names and second contain multiple semicolons separated values I want to separate the second column and transpose with first column value repeated,
example
sheet:
testa KRAS;EGFR
second HSP90AB1;KSR1;PLXND1;LAMB2;ROCK2
test PPP2R1A;TRIB3;EGFR;FGFR2
Result:
testa KRAS
testa EGFR
second HSP90AB1
second KSR1
second PLXND1
second LAMB2
second ROCK2
test PPP2R1A
test TRIB3
test EGFR
test FGFR2
Right now I am manually separating it, is there any macros/VBA for this?

Answer 1

I happen to have a macro that pretty much does this, so I just tweaked it to match your data. Otherwise, I'd also ask that you show some effort first. I assume your data is in column A ("testa", "second", etc) and column B (the delimited data)
Sub splitCopyDown()
Dim rng As Range, cel As Range
Dim cols As Long, lastRow As Long, i As Long, k As Long
Set rng = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
rng.TextToColumns Destination:=Range("B1"), Semicolon:=True
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = lastRow To 1 Step -1
cols = Cells(i, Columns.Count).End(xlToLeft).Column
Set rng = Range(Cells(i, 3), Cells(i, cols))
Range(rng.Offset(1, 0), rng.Offset(cols - 2, 0)).EntireRow.Insert
rng.Copy
rng.Cells(1).Offset(1, -1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
rng.Clear
Next i
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
Range(Cells(1, 1), Cells(lastRow, 1)).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c"
Range(Cells(1, 1), Cells(lastRow, 1)).Value = Range(Cells(1, 1), Cells(lastRow, 1)).Value
End Sub
(It's an older macro, but it checks out. You could likely make it more efficient)

Answer 2

While BruceWayne beat me to the punch, I quickly jotted this subroutine out so I figured I should share it so I don't feel like I wasted 5 minutes of my day.
Sub liftAndSeperate()
Dim rngData As Range
Dim intWriteRow As Integer
Dim rngReadRow As Range
Dim readArrayElem As Variant
'Assuming the data is in Sheet1 A1:B20
Set rngData = Sheet1.Range("A1:B20")
'Assuming we will write to Sheet2 starting at row 1:
intWriteRow = 1
'Loop through each row in that range:
'The row we are reading will be held in variable rngReadRow
For Each rngReadRow In rngData.Rows
'Generate an array using split and loop through the array to write the values out
For Each readArrayElem In Split(rngReadRow.Cells(1, 2).Value, ";")
'Write out column A from sheet1 to sheet2
Sheet2.Cells(intWriteRow, 1).Value = rngReadRow.Cells(1, 1)
'Write out the array element
Sheet2.Cells(intWriteRow, 2).Value = readArrayElem
'Increment to the next write row
intWriteRow = intWriteRow + 1
Next readArrayElem
Next rngReadRow
End Sub
p.s. BruceWayne is Batman (now his cover is blown)