Link to home
Start Free TrialLog in
Avatar of Watnog
WatnogFlag for Belgium

asked on

Unmerge cell and split into rows

Hi dear Experts,

I've been searching for a while but could not lay my finger on a ready answer.
In attached sheet data is organized per row, some cells icontain merged data.
In order to work with that data those values should be unmerged and spllit into rows.
The relevant column is B. It has a pendant in column G. Merged data in other cells can be unmerged too if that would simplify things a bit.
I hope the example makes things clear, and also that this is possible.
Thanks.
tobeunmerged.xls
ASKER CERTIFIED SOLUTION
Avatar of Patrick Matthews
Patrick Matthews
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Watnog

ASKER

Thank you very much, this makes my day.
This code goes against the Sheet, it is not meant for a module since it works on current sheet only.
Sub unmergeme()
Dim lastRow As Long, extent As Long, r As Range
Dim s As String, parts() As String, i As Integer
lastRow = 0
Set r = Cells.Find(Chr(10), UsedRange.SpecialCells(xlCellTypeLastCell), , xlPart)
While Not r Is Nothing
    If r.Row <> lastRow Then extent = 1: lastRow = r.Row
    parts = Split(r.Value, Chr(10))
    If UBound(parts) + 1 > extent Then
        r.Offset(extent).Resize(UBound(parts) + 1 - extent).EntireRow.Insert
        extent = UBound(parts) + 1
    End If
    For i = 0 To UBound(parts)
        r.Offset(i).Value = parts(i)
    Next
    Set r = Cells.Find(Chr(10), r, , xlPart)
Wend
End Sub

Open in new window

Avatar of Watnog

ASKER

I pasted the code into into a new module of my personal.xls and it works fine.
It should only work on current sheet in fact.
Excuse me my ignorance, but what makes code suitable for a module (or not)?