Excel - split and transpose with inserted rows - excel

Question

What code would I be using to achieve this in vba, I've been trying to adapt other codes that I have seen online to my needs but it's not working out. I'll greatly appreciate any help.
I get the data in this format:
Col A Col B Col C Col D
QBC T 90125 LAK-912,323.YVS-PK,US.
QOL T 53241 LWA-324.
QEF F 31236 PKS-634,432,243.
and I would like the data to be extracted as:
Col A Col B Col C Col D
QBC T 90125 LAK-912
QBC T 90125 LAK-323
QBC T 90125 YVS-PK
QBC T 90125 YVS-US
QOL T 53241 LWA-324
QEF F 31236 PKS-634
QEF F 31236 PKS-432
QEF F 31236 PKS-243
Hope it is clear!

Answer 1

This sub create the list from the cell F2:
Dim LastRow As Long
Dim RowsOffset, ColsOffset, e, k As Long
Dim Str As String
Dim StrB, StrN As String
Dim Start As Long
Range("A1").Activate
LastRow = Range(ActiveCell.SpecialCells(xlLastCell).Address).Row
RowsOffset = 0
ColsOffset = 5
For e = 1 To LastRow
Str = ActiveCell.Offset(e, 3).Value
StrB = ""
StrN = ""
Start = 1
For k = 1 To Len(Str)
If Mid(Str, k, 1) = "," Then
StrN = Mid(Str, Start, k - Start)
Start = k + 1
RowsOffset = RowsOffset + 1
ActiveCell.Offset(RowsOffset, ColsOffset).Value = ActiveCell.Offset(e, 0).Value
ActiveCell.Offset(RowsOffset, ColsOffset + 1).Value = ActiveCell.Offset(e, 1).Value
ActiveCell.Offset(RowsOffset, ColsOffset + 2).Value = ActiveCell.Offset(e, 2).Value
ActiveCell.Offset(RowsOffset, ColsOffset + 3).Value = StrB & StrN
End If
If Mid(Str, k, 1) = "." Then
StrN = Mid(Str, Start, k - Start)
Start = k + 1
RowsOffset = RowsOffset + 1
ActiveCell.Offset(RowsOffset, ColsOffset).Value = ActiveCell.Offset(e, 0).Value
ActiveCell.Offset(RowsOffset, ColsOffset + 1).Value = ActiveCell.Offset(e, 1).Value
ActiveCell.Offset(RowsOffset, ColsOffset + 2).Value = ActiveCell.Offset(e, 2).Value
ActiveCell.Offset(RowsOffset, ColsOffset + 3).Value = StrB & StrN
End If
If Mid(Str, k, 1) = "-" Then
StrB = Mid(Str, Start, k - Start + 1)
Start = k + 1
End If
Next
If you want another position, change:
RowsOffset = 0 ' Rows Offset
ColsOffset = 5 ' Column Offset
If you want another sheet, the code it's a little different. YOu need to change the 8 line with Activecell with:
Sheets("Sheet2").Range("A1").Offset(RowsOffset, ColsOffset).Value = ActiveCell.Offset(e, 0).Value

Answer 2

The SplitAndExpand() function takes a string like in the original "Col D" and returns an array of strings as wanted in the final "Col D". Modify and call Test() from the immediate window to check the function:
Public Function SplitAndExpand(ByVal Str As String) As String()
Dim sdot() As String
Dim scomma() As Variant
Dim prefix As String
Dim result() As String
Dim i As Long
Dim j As Long
Dim n As Long
' This code is NOT the most efficient.
' 1. Split the string at ".", ignore the last empty string
Let sdot = Strings.Split(Str, ".")
If sdot(UBound(sdot)) = "" Then
ReDim Preserve sdot(0 To (UBound(sdot) - 1))
End If
' 2. For each sdot substring, split it at ","
ReDim scomma(0 To UBound(sdot))
Let n = 0
For i = 0 To UBound(sdot)
' Split
Let scomma(i) = Strings.Split(sdot(i), ",")
' Cumulate results from this split
Let n = n + UBound(scomma(i)) + 1
Next i
' 3. Build result from the prefix of the first scomma string and the
' rest of the strings. Result array is 1-based
ReDim result(1 To n)
Let n = 0
For i = 0 To UBound(scomma)
' Add the first entry and calculate prefix
Let n = n + 1
Let result(n) = scomma(i)(0)
Let prefix = Strings.Split(result(n), "-")(0) & "-"
' Assemble the rest of the entries, and save them
For j = 1 To UBound(scomma(i))
Let n = n + 1
Let result(n) = prefix & scomma(i)(j)
Next j
Next i
' 4. Return value
Let SplitAndExpand = result
End Function
Public Sub Test()
Dim a() As String
Dim k As Long
Let a = SplitAndExpand("LAK-912,323.YVS-PK,US.")
For k = LBound(a) To UBound(a)
Debug.Print a(k)
Next k
End Sub