Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 01-10-2018, 11:49 AM
kilroy kilroy is offline Windows 10 Office 2016
Advanced Beginner
 
Join Date: Sep 2016
Posts: 37
kilroy is on a distinguished road
Default Unmerging vertically merged cells

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



I'm hoping someone here might have some ideas. I have some code (written by Graham) that unmerges vertically merged cells however it only works on column 1. 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. I'm wondering if any here might have some suggestions? I've attached 2 documents: R1 is how it works now and R2 is an example of other columns with vertically merged cells before and after. There will always be at least one column without any cells merged vertically. Thanks for any suggestions.

Code:
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 
Attached Files
File Type: docx merge test - r1.docx (29.7 KB, 3 views)
File Type: docx merge test - r2.docx (29.9 KB, 2 views)
Reply With Quote
  #2  
Old 01-10-2018, 09:39 PM
macropod's Avatar
macropod macropod is online now Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 18,662
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Cross-posted at: http://www.vbaexpress.com/forum/show...y-merged-cells
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

PS: Your thread at VBAX has not been closed.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #3  
Old 01-11-2018, 12:55 AM
slaycock slaycock is offline Windows 7 64bit Office 2016
Expert
 
Join Date: Sep 2013
Posts: 255
slaycock is on a distinguished road
Default

You can assist by adding comment to the code to explain what you are trying to do. Your current code is rather opaque.
Reply With Quote
  #4  
Old 01-12-2018, 06:10 AM
kilroy kilroy is offline Windows 10 Office 2016
Advanced Beginner
 
Join Date: Sep 2016
Posts: 37
kilroy is on a distinguished road
Default

Slay I'm not sure what you mean by opaque but I didn't write this code it is way above me. I have vertically merged cells in a word table that I need un merged. This code works for column 1 only and works perfectly but I have been coming across instances where vertically merged cells are in other columns. My tables are usually 4 columns maybe 5. I'm pretty sure it was Graham who wrote this code.
Reply With Quote
  #5  
Old 01-12-2018, 06:14 AM
kilroy kilroy is offline Windows 10 Office 2016
Advanced Beginner
 
Join Date: Sep 2016
Posts: 37
kilroy is on a distinguished road
Default

Paul this thread was marked as solved at VBA Express so I would not expect this to be an issue. I made the comment here 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 here that may be able to help? Or that no one here would find this information useful?

Reply With Quote
  #6  
Old 01-12-2018, 12:54 PM
macropod's Avatar
macropod macropod is online now Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 18,662
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Notifying forums of where the previous discussion occurred is a common courtesy that is expect on all forums. In this case, without the links, no-one would see the advice you were given re Excel, for example, that you've yet to say whether it meets your needs. Furthermore, the marking of a thread as solved at VBAX does not close it.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Overcome issues in tables with vertically merged cells rocky2 Word VBA 12 12-22-2016 03:03 AM
How to vertically align a merged cell to fit text paik1002 Excel 6 09-20-2016 03:00 AM
Table will not allow sorting because "cells are merged". I can't find the merged cells. wendyloooo Word Tables 1 05-26-2015 01:19 PM
Unable to vertically center align texts in table cells? tinfanide Word 3 11-24-2013 06:37 AM
How to merge matching cells vertically? Odiseh Excel 1 01-02-2010 02:41 PM


All times are GMT -7. The time now is 05:29 PM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft