Consulting

Results 1 to 2 of 2

Thread: merge cells upto blank cells

  1. #1
    VBAX Contributor
    Joined
    May 2010
    Posts
    106
    Location

    merge cells upto blank cells

    Hi Guys,

    I had bunch of client supplied word files, which single paragraph is divided into multiple cells.

    Attached file for your reference.

    What I right now doing is selecting the cells manually and merge the cells through Menu Bar/Table/Merge Cells and replacing paragraph return with space.


    Can it possible to do it by macro?

    If so it saves me a day!!!!

    Thanks
    Rakesh
    Attached Files Attached Files

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,118
    Location
    This should get you close:

    Sub ScratchMacro()
    'A basic Word macro coded by Greg Maxey
    Dim oTbl As Table, oRow As Row, lngIndex As Long, lngCol As Long
    Dim oRng As Range
    Set oTbl = ActiveDocument.Tables(1)
      Set oRng = oTbl.Rows(1).Range
      Do
        Do
          oRng.MoveEnd wdRow, 1
        Loop Until Len(oRng.Rows.Last.Range) = 14
        For lngIndex = 2 To oRng.Rows.Count - 1
          For lngCol = 1 To 6
            oRng.Rows(1).Cells(lngCol).Range.Text = Trim(Left(oRng.Rows(1).Cells(lngCol).Range.Text, _
                      Len(oRng.Rows(1).Cells(lngCol).Range.Text) - 2) & " " & Left(oRng.Rows(lngIndex).Cells(lngCol).Range.Text, _
                      Len(oRng.Rows(lngIndex).Cells(lngCol).Range.Text) - 2))
          Next lngCol
        Next lngIndex
        For lngIndex = oRng.Rows.Count - 1 To 2 Step -1
          oRng.Rows(lngIndex).Delete
        Next lngIndex
        On Error GoTo lbl_Exit
        Set oRng = oRng.Rows.Last.Next.Range
      Loop
    lbl_Exit:
      Exit Sub
      
    End Sub
    Greg

    Visit my website: http://gregmaxey.com

Posting Permissions

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