Spit Data in Single Cell into Multiple Rows - excel

Question

I have a data set with Names and Addresses in an Excel file in following format.
Name1
134/47/1,
adrs1, adr2, country
Name2
adrs1, adrs2, country
Name3
107/c,
adrs3, adrs3, country
etc…
I want to split these data into multiple rows in following format
Name1
134/47/1,
adrs1,
adrs2,
country
Name2
No 134/63,
adrs1,
adrs2,
country
etc…
I tried following but it worked for one row cell only.
Sub tst()
Dim X As Variant
X = Split(Range("A1").Value, ",")
Range("A1").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End Sub

Answer 1

The following macro might help you. You would have to select the very last cell in your table containing a multipart address. When you start the macro it will then work its way up to the top and insert address lines where needed (only in the current column) and then exit.
Option Base 1
Sub trnsfrm()
Dim i%, n%, ret(3, 1)
Set r = Selection
Do
a = Split(r, ",")
ret(1, 1) = Trim(a(0))
ret(2, 1) = Trim(a(1))
ret(3, 1) = Trim(a(2))
r.Range([a2], [a3]).Insert Shift:=xlDown
r.Range([a1], [a3]) = ret
If r.Row <= 4 Then Exit Do
Set r = r.Offset(-4)
Loop
End Sub
If you want to insert lines across the whole table you should replace the line (10)
r.Range([a2], [a3]).Insert Shift:=xlDown
by
r.Range([a2], [a3]).EntireRow.Insert Shift:=xlDown
Assumptions / Warning
Since the macro will actually change your current table and 'undo' does not work with macros you should definitely save everything before you try it.
The macro assumes that each address block consists of exactly 4 lines. If there are fewer or more lines to an address the maro will get out of sync and will very likely output garbage or halt.

Answer 2

I'm not sure whether your sample data had trailing commas on single values as a typo or if that is what accurately represents your data but that should be accounted for. A rogue comma as a suffix will create an extra element to the variant array thereby throwing off dimensions created by referencing the UBound function.
Sub split_from_below_space()
Dim rw As Long, v As Long, vVALs As Variant
With Worksheets("Sheet1") 'set this worksheet reference properly!
For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
.Cells(rw, 1) = Trim(.Cells(rw, 1).Value2)
If CBool(InStr(1, .Cells(rw, 1).Value2, Chr(44) & Chr(32))) Then
vVALs = Split(.Cells(rw, 1).Value2, Chr(44) & Chr(32))
.Cells(rw + 1, 1).Resize(UBound(vVALs), 1).EntireRow.Insert
.Cells(rw, 1).Resize(UBound(vVALs) + 1, 1) = _
Application.Transpose(vVALs)
For v = UBound(vVALs) - 1 To LBound(vVALs) Step -1
.Cells(rw, 1).Offset(v, 0) = _
Trim(.Cells(rw, 1).Offset(v, 0).Value2) & Chr(44)
Next v
End If
Next rw
End With
End Sub
You will need to insert rows to accommodate the data and that method is almost always (as in this case) better performed by working from the bottom to the top.