Macro to split table cells

nachiketapte · #1 03-07-2016, 10:20 PM

I have the below requirement. I have a input similar to this

#

Drawings

Drawing Type

1

Drawing 4, Drawing 27

EC, C

Now I would like to have the output similar to this

#

Drawings

Drawing Type

1

Drawing 4

EC

2

Drawing 27

C

Can some expert help me with this

I found the following piece of code written on one of the forum and thought would be of help to me.

Code:

Sub TableSplitter()
Application.ScreenUpdating = False
Dim Tbl As Table, RngFnd As Range, StrFindTxt As String
StrFindTxt = InputBox(",")
If Trim(StrFindTxt) = "" Then Exit Sub
For Each Tbl In ActiveDocument.Tables
  Set RngFnd = Tbl.Range
  With RngFnd.Find
    .ClearFormatting
    .Text = StrFindTxt
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    Do While .Execute
      With RngFnd.Duplicate
        'The next two lines break the table *after* the found row
        If .Cells(1).RowIndex < .Tables(1).Rows.Count Then
          .Tables(1).Split .Cells(1).RowIndex + 1
        End If
        'The next two lines break the table *before* the found row
        If .Cells(1).RowIndex > 1 Then
          .Tables(1).Split .Cells(1).RowIndex
        End If
        .Collapse (wdCollapseEnd)
      End With
    Loop
  End With
Next
Set RngFnd = Nothing
Application.ScreenUpdating = True
End Sub

macropod · #2 03-07-2016, 10:34 PM

Hi nachiketapte,

It would be easier to understand you needs if you attached an actual document to a post containing tables showing the before & after requirements. You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.

As for the macro included with your post, it's written for splitting tables, not cells.

PS: When posting code, please use the code tags, indicated by the # button on the posting menu.

nachiketapte · #3 03-07-2016, 10:49 PM

Quote:

Originally Posted by macropod

Hi nachiketapte,

It would be easier to understand you needs if you attached an actual document to a post containing tables showing the before & after requirements. You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.

As for the macro included with your post, it's written for splitting tables, not cells.

PS: When posting code, please use the code tags, indicated by the # button on the posting menu.

thanks macropod. do you have a word macro for the issue I mentioned. I am unfortunately not able to post the document due to security restrictions but I think you got the message

macropod · #4 03-07-2016, 11:01 PM

It's impossible to discern the cell content & table structure from your post, so it's not possible at this stage to write a macro to do the processing. We don't need to see your 'live' document, just a sample document showing an actual before & after table using, say, the sample data in your post, to show what the macro is supposed to do.

nachiketapte · #5 03-07-2016, 11:05 PM

uploaded for your reference

macropod · #6 03-07-2016, 11:36 PM

Although there are two tables in your document, neither of them appears to show how what you apparently want the first one reformatted.

nachiketapte · #7 03-08-2016, 12:02 AM

Quote:

Originally Posted by macropod

Although there are two tables in your document, neither of them appears to show how what you apparently want the first one reformatted.

I don't understand where the confusion. Just focus on the first table. The first row of the table has 3 columns. Sr. # , Drawings, Drawing Type. I have values as 1, Drawing 4, Drawing 27 and EC,C in the first row. My goal is to have values similar to this

1 Drawing4 EC
2 Drawing27 C

I hope I have made myself clear

macropod · #8 03-08-2016, 12:13 AM

Quote:

Originally Posted by nachiketapte

I don't understand where the confusion. Just focus on the first table. The first row of the table has 3 columns. Sr. # , Drawings, Drawing Type. I have values as 1, Drawing 4, Drawing 27 and EC,C in the first row. My goal is to have values similar to this

1 Drawing4 EC
2 Drawing27 C

I hope I have made myself clear

Well, if you look at your first post, I doubt even you could discern the required structure from that...

macropod · #9 03-08-2016, 02:21 AM

Try the following macro. Do be aware that your current table's Drawing 4, Drawing 27 & EC, C content is actually supplied via DOCPROPERTY fields pointing to properties named drawing_id and drawing_tmpl_type, respectively. Those fields cannot survive the restructuring.

Code:

Sub ReformatTables()
Dim t As Long, i As Long, StrDrwgs As String, StrTypes As String
With ActiveDocument
  For t = .Tables.Count To 1 Step -1
    With .Tables(t)
      If Trim(Split(.Cell(1, 2).Range, Chr(13))(0)) = "Drawings" Then
        StrDrwgs = Trim(Split(.Cell(2, 2).Range, Chr(13))(0))
        StrTypes = Trim(Split(.Cell(2, 3).Range, Chr(13))(0))
        For i = 1 To UBound(Split(StrDrwgs, ","))
          With .Rows.Last.Range
            .Next.InsertBefore vbCr
            .Next.FormattedText = .FormattedText
          End With
          With .Rows.Last.Range
            .Cells(1).Range.Text = i + 1
            .Cells(2).Range.Text = Trim(Split(StrDrwgs, ",")(i))
            .Cells(3).Range.Text = Trim(Split(StrTypes, ",")(i))
          End With
        Next
        With .Rows(2).Range
          .Cells(1).Range.Text = 1
          .Cells(2).Range.Text = Trim(Split(StrDrwgs, ",")(0))
          .Cells(3).Range.Text = Trim(Split(StrTypes, ",")(0))
        End With
      End If
    End With
  Next
End With
End Sub

nachiketapte · #10 03-08-2016, 03:27 AM

Many thanks. It worked.
Assuming we have a table with 5 columns out of which column 2,3,4 are columns having comma separated values which is the 2nd table in my document attached. How do we achieve the same.

macropod · #11 03-08-2016, 04:07 AM

It would have been helpful had you specified your requirements in full from the outset. Try:

Code:

Sub ReformatTables()
Dim t As Long, i As Long, StrDrwgs As String, StrTypes As String
Dim StrEngineer As String, StrTED As String, StrTPD As String, Rng As Range
With ActiveDocument
  For t = .Tables.Count To 1 Step -1
    With .Tables(t)
      If Trim(Split(.Cell(1, 2).Range, Chr(13))(0)) = "Drawings" Then
        StrDrwgs = Trim(Split(.Cell(2, 2).Range, Chr(13))(0))
        StrTypes = Trim(Split(.Cell(2, 3).Range, Chr(13))(0))
        For i = 1 To UBound(Split(StrDrwgs, ","))
          With .Rows.Last.Range
            .Next.InsertBefore vbCr
            .Next.FormattedText = .FormattedText
          End With
          With .Rows.Last.Range
            .Cells(1).Range.Text = i + 1
            .Cells(2).Range.Text = Trim(Split(StrDrwgs, ",")(i))
            .Cells(3).Range.Text = Trim(Split(StrTypes, ",")(i))
          End With
        Next
        With .Rows(2).Range
          .Cells(1).Range.Text = 1
          .Cells(2).Range.Text = Trim(Split(StrDrwgs, ",")(0))
          .Cells(3).Range.Text = Trim(Split(StrTypes, ",")(0))
        End With
      End If
      If Trim(Split(.Cell(1, 2).Range, Chr(13))(0)) = "Project Engineer" Then
        .Split .Rows.Count
        StrEngineer = Trim(Split(.Cell(2, 2).Range, Chr(13))(0))
        StrTED = Trim(Split(.Cell(2, 3).Range, Chr(13))(0))
        StrTPD = Trim(Split(.Cell(2, 4).Range, Chr(13))(0))
        For i = 1 To UBound(Split(StrEngineer, ","))
          With .Rows.Last.Range
            .Next.InsertBefore vbCr
            .Next.FormattedText = .FormattedText
          End With
          With .Rows.Last.Range
            .Cells(2).Range.Text = Trim(Split(StrEngineer, ",")(i))
            .Cells(3).Range.Text = Trim(Split(StrTED, ",")(i))
            .Cells(4).Range.Text = Trim(Split(StrTPD, ",")(i))
          End With
        Next
        With .Rows(2).Range
            .Cells(2).Range.Text = Trim(Split(StrEngineer, ",")(0))
            .Cells(3).Range.Text = Trim(Split(StrTED, ",")(0))
            .Cells(4).Range.Text = Trim(Split(StrTPD, ",")(0))
        End With
        .Range.Characters.Last.Next.Delete
      End If
    End With
  Next
End With
End Sub

PS: There is no need to quote every post you reply to - doing so just adds clutter.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
split row of cells at semicolon	lbeck	Excel	8	06-06-2015 01:55 PM
how to split merged data into vertical saperate cells	cheekugreat	Excel	5	10-11-2014 05:53 AM
Macro to loop through all cells in a table produced by a mail merge	elh52	Word VBA	4	08-31-2014 10:50 PM
Losing rows when pasting split cells	Gitley	Word Tables	1	01-15-2013 07:49 AM
Macro to Merge Cells Row By Row in a Table	KD999	Word VBA	4	02-20-2012 08:51 PM