Solved

Unmerge cell and split into rows

Posted on 2010-08-20
4
336 Views
Last Modified: 2012-05-10
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
0
Comment
Question by:Watnog
  • 2
4 Comments
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 500 total points
ID: 33483617
Assuming that you have headings in Row 1 for all the columns you car about, this seems to be working.  It "unmerges" all of the cells.  (The cells are not truly merged in the Excel sense, of course...)
Sub RedoList()
    
    Dim LastR As Long, LastC As Long
    Dim arr As Variant
    Dim r As Long, c As Long
    Dim CellContents As Variant
    Dim MaxRows As Long
    Dim DestR As Long
    
    With ActiveSheet
        LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
        LastC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        arr = .Range(.Cells(1, 1), .Cells(LastR, LastC)).Value
    End With
    
    Worksheets.Add
    DestR = 1
    
    For r = 1 To UBound(arr, 1)
        MaxRows = 0
        For c = 1 To UBound(arr, 2)
            If arr(r, c) <> "" Then
                CellContents = Split(arr(r, c), Chr(10))
                Cells(DestR, c).Resize(UBound(CellContents) + 1, 1) = Application.Transpose(CellContents)
                If (UBound(CellContents) + 1) > MaxRows Then MaxRows = (UBound(CellContents) + 1)
            End If
        Next
        DestR = DestR + MaxRows
    Next
    
    MsgBox "Done"
    
End Sub

Open in new window

0
 

Author Closing Comment

by:Watnog
ID: 33483787
Thank you very much, this makes my day.
0
 
LVL 58

Expert Comment

by:cyberkiwi
ID: 33483789
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

0
 

Author Comment

by:Watnog
ID: 33483863
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)?
0

Featured Post

VMware Disaster Recovery and Data Protection

In this expert guide, you’ll learn about the components of a Modern Data Center. You will use cases for the value-added capabilities of Veeam®, including combining backup and replication for VMware disaster recovery and using replication for data center migration.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

810 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question