Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 21

Thread: Unmerging Vertically merged cells.

  1. #1
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location

    Unmerging Vertically merged cells.

    merge test - Copy.docx

    Guys I have a table with vertically merged cells in the first column. What I need to happen is that it unmerges and gives the value of the top cell to blank cells newly created. I'm not sure where to even start. Thanks in advance for any help.
    Last edited by Kilroy; 06-13-2017 at 01:13 PM. Reason: Couldn't paste table

  2. #2
    Provided that the table matches exactly i.e. the same number of merged cells in each segment then the following should work

    Sub Macro1()
    Dim oTable As Table
    Dim oCell As Range, sText
    Dim i As Integer
        Set oTable = ActiveDocument.Tables(1)
        For i = oTable.Columns(1).Cells.Count To 2 Step -1
            oTable.Columns(1).Cells(i).Split 4, 1
        Next i
        For i = 2 To oTable.Rows.Count
            Set oCell = oTable.Rows(i).Cells(1).Range
            oCell.End = oCell.End - 1
            If Len(oCell) > 1 Then
                sText = oTable.Rows(i).Cells(1).Range.Text
            Else
                oCell.Text = sText
                oCell.Text = Replace(oCell.Text, Chr(13), "")
            End If
        Next i
    lbl_Exit:
        Set oTable = Nothing
        Set oCell = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    Thanks for the reply Graham. How have you been? This table is not typical. Each merged cell could be any number of rows.

  4. #4
    Post a table that is typical and it may be possible to help.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    merge test - Copyr1.docx

    I do not have a typical table really. Each one is a checklist prepared and based on different manuals. The table in the attached example has differing amounts of rows behind each merged cell. I went from 2 up to 6 but there could be many more. Possibly anywhere from 2 - 25 or more. Thanks for looking into this.

  6. #6
    Hmmm. The complicated bit is working out how many rows to split the merged cells into, and the code below could no doubt be simplified, however the following will work with your examples, but it will not work if there are any horizontally merged cells in the table.

    Option Explicit
    Sub Macro1()
    Dim i As Long, j As Long, k As Long
    Dim sData() As Variant
    Dim oTable As Table
    Dim oCell As Cell
    Dim oRng As Range
    Dim sText As String
    Dim sRow As String
    Dim iRow As Long
    Dim oColl1 As New Collection
    Dim oColl2 As New Collection
        Set oTable = ActiveDocument.Tables(1)
        With oTable
            ReDim sData(1 To .Rows.Count, 1 To .Columns.Count)
            Set oCell = .Cell(1, 1)
            Do While Not oCell Is Nothing
                sData(oCell.RowIndex, oCell.ColumnIndex) = oCell.RowIndex & "," & oCell.ColumnIndex
                Set oCell = oCell.Next
            Loop
            For i = 1 To UBound(sData)
                sRow = ""
                For j = 1 To UBound(sData, 2)
                    sRow = sRow & IIf(IsEmpty(sData(i, j)), "X", "A") & "|"
                Next j
                oColl1.Add sRow
            Next i
            j = 1
            For i = oColl1.Count To 1 Step -1
                If Left(oColl1(i), 1) = "X" Then
                    j = j + 1
                    k = j
                Else
                    k = j
                    j = 1
                End If
                If j = 1 Then oColl2.Add k
            Next i
            iRow = oTable.Columns(1).Cells.Count
            k = iRow
            For j = 1 To oColl2.Count
                For i = oColl2.Count To 1 Step -iRow
                    oTable.Columns(1).Cells(k).Split oColl2(j), 1
                    k = k - 1
                Next i
            Next j
        End With
    
        For i = 2 To oTable.Rows.Count
            Set oRng = oTable.Rows(i).Cells(1).Range
            oRng.End = oRng.End - 1
            If Len(oRng) > 1 Then
                sText = oTable.Rows(i).Cells(1).Range.Text
            Else
                oRng.Text = sText
                oRng.Text = Replace(oRng.Text, Chr(13), "")
            End If
        Next i
    
    lbl_Exit:
        Set oColl1 = Nothing
        Set oColl2 = Nothing
        Set oTable = Nothing
        Set oCell = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    Works perfectly Graham. Thanks. It will take me a while to even figure out how it works. LOL.

  8. #8
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    I still can't figure this one out. I've tried everything I can think of to get this to work on columns other than the column 1. Any suggestions?

  9. #9
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    If your table's cells each contain no more than a single paragraph, the simplest approach might be to copy & paste the table into Excel, use its unmerge cells function (which Word lacks), then copy & paste the table back into Word for whatever further processing you want to do.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  10. #10
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    Thanks Paul. the merged cells will almost definitely have more than one paragraph

  11. #11
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    In that case, provided the paragraphs in a given cell have the same format, you could use Find/Replace before copying to Excel:
    Find = ^p
    Replace = ¶
    Find = ^l
    Replace =
    and perhaps:
    Find = ^t
    Replace =
    before copying & pasting into Excel, then reversing the process after copying & pasting the unmerged table back into Word.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  12. #12
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    Thanks Paul I will give this a try.

  13. #13
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    Bump. Anyone else have any ideas how to apply this to columns other than column 1?

  14. #14
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Cross-posted at: http://www.msofficeforums.com/word-v...ged-cells.html
    Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  15. #15
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    Paul this thread is marked as solved here so I would not expect this to be an issue. I made the comment on the other thread at Microsoft Office Forums that it had been posted elsewhere first. I'm not sure what you're trying to accomplish by posting that I crossed posted. I was very up front. The very first line on the other thread is as follows:

    " ***This issue was raised on a different forum first but marked as closed with no real solution.*** "

    Are you telling me that there are no different people over there that may be able to help?

  16. #16
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    The thread here was marked as solved before you even bumped it, besides which you could mark it unsolved. In any event, you didn't have the courtesy to let anyone here know you'd cross-posted, which is a requirement, and you didn't let anyone there know where you'd cross-posted, meaning they wouldn't know what discussion had gone on here beforehand.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  17. #17
    VBAX Newbie
    Joined
    Dec 2018
    Posts
    3
    Location
    I had modified the code initially done by Graham.

    1. Code will split for all columns
    2. Split cells will contain previous merged cell value (Graham code even replaced previously empty cell, now the bug is squashed)
    3. Added comments where ever possible for easier understanding of what each block does

    In my opinion, i can do the same work in C#.Net Word VSTO Addin in less than an hour with the help of full fledged OOPS language, rather than writing huge boilerplate code just to split cells in table with vba.

    Function SplitVerticalMerge()
        'Created by Chandraprakash [Yoh]
        Dim i As Long, j As Long, k As Long, cols As Long, m As Long
        Dim sData() As Variant
        Dim oTable As Table
        Dim oCell As Cell
        Dim oRng As Range
        Dim sText As String
        Dim sRow As String
        Dim iRow As Long
        
        'Rows of Merged and NonMerged cells in Table
        Dim oColl1 As New Collection
        
        'Row with number of merged cells in Table (Vertical Split Number)
        Dim oColl2 As New Collection
            
        Set oTable = ActiveDocument.Tables(1)
        With oTable
            
            'Load all the Table cell index
            ReDim sData(1 To .Rows.Count, 1 To .Columns.Count)
            Set oCell = .Cell(1, 1)
            Do While Not oCell Is Nothing
                sData(oCell.RowIndex, oCell.ColumnIndex) = oCell.RowIndex & "," & oCell.ColumnIndex
                Set oCell = oCell.Next
            Loop
            
            '1. Mark the merged cell as "X"
            '2. Mark the non merged cell as "A"
            '3. Load the result for each row to Collection1
            For i = 1 To UBound(sData)
                sRow = ""
                For j = 1 To UBound(sData, 2)
                    sRow = sRow & IIf(IsEmpty(sData(i, j)), "X", "A") ' & "|"
                Next j
                oColl1.Add sRow
            Next i
            
            For cols = 1 To oTable.Columns.Count
                'Load one by one Row with number of merged cells in Table (Vertical Split Number)
                Set oColl2 = Nothing
                j = 1
                For i = oColl1.Count To 1 Step -1
                    '"X" - Merged
                    If Mid(oColl1(i), cols, 1) = "X" Then
                        j = j + 1
                        k = j
                    '"A" - NotMerged
                    Else
                        k = j
                        j = 1
                    End If
                    If j = 1 Then oColl2.Add k
                Next i
                
                iRow = oTable.Columns(cols).Cells.Count
                k = iRow
                For j = 1 To oColl2.Count
                    For i = oColl2.Count To 1 Step -iRow
                        'cols - Column Number
                        'k - cell row number in column (cols)
                        'j - Split number for the cell (k)
                        
                        'Split the cell by above attributes defined
                        oTable.Columns(cols).Cells(k).Split oColl2(j), 1
                        
                        '1. Enter if merged cell is split (j>1)
                        '2. Will fill the values for split empty cell with previous merged cell value
                        If oColl2(j) > 1 Then
                            For m = 1 To oColl2(j) - 1
                                oTable.Columns(cols).Cells(k + m).Range.Text = oTable.Columns(cols).Cells(k).Range.Text
                            Next m
                        End If
                        
                        k = k - 1
                    Next i
                Next j
            Next cols
            
            'To avoid application freezing
            DoEvents
        End With
    
    
    lbl_Exit:
        Set oColl1 = Nothing
        Set oColl2 = Nothing
        
        Set oTable = Nothing
        Set oCell = Nothing
        Set oRng = Nothing
        Exit Function
    End Function

  18. #18
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    Thanks JOH this code works really well for unmerging all but how do have it focus on a specific column?

  19. #19
    VBAX Newbie
    Joined
    Dec 2018
    Posts
    3
    Location
    Remove this For loop which loops all columns in table - Remove only that two lines,

    For cols = 1 To oTable.Columns.Count [place cols = 1 to n - whatever column number you want to run for]
    Next cols

    Btw it's Yoh and not Joh :|

  20. #20
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    Works great.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •