Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 06-09-2022, 11:02 AM
Kalü Kalü is offline Split Data from Mergefield into seperate rows Windows 10 Split Data from Mergefield into seperate rows Office 2010 32bit
Advanced Beginner
Split Data from Mergefield into seperate rows
 
Join Date: Apr 2018
Posts: 43
Kalü is on a distinguished road
Default Split Data from Mergefield into seperate rows

Hey there,

I have a mailmerge document which creates a single table for each client.

In row 14 there is one Mailmerge field called Partners. There are many names sepreated by commata. Is it possible to split these names into rows (one row for each name) so that word creates automatically new rows?

I tried it with vba and macro recording but nothing is working out reliable and im so sad right now because i have to do this work every week all manually -.-
Reply With Quote
  #2  
Old 06-10-2022, 07:14 AM
macropod's Avatar
macropod macropod is offline Split Data from Mergefield into seperate rows Windows 10 Split Data from Mergefield into seperate rows Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Mailmerge can't do that.

A macro would be needed, but you haven't told us enough about the table for a solution to be developed. For example:
Is it the first table for each record?
In which column are the partner names?
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 06-13-2022, 10:25 AM
Kalü Kalü is offline Split Data from Mergefield into seperate rows Windows 10 Split Data from Mergefield into seperate rows Office 2010 32bit
Advanced Beginner
Split Data from Mergefield into seperate rows
 
Join Date: Apr 2018
Posts: 43
Kalü is on a distinguished road
Default More information and files

Hi Macropod,


thank you very much for your reply! Tbh I actually tried to simplyfy my problem a bit. Let me tell you everything to make it easier to understand:


I get a bunch of word files every week. Every Word file contains one table which is my "recipients data" for mail merging. I manually search and clean up each table in those word files and copy it to my "Source.docx".


My mail merge "Master.docx" is of course another word file which is an empty file with a completly other table where i put my mergefields in the diferent cells. (To make it even harder, I have two master files: one has a green table "master1.docx" and the other one has a red table "master2.docx".
But the tables are identically only the filling color is different.

So I create two mail merg documents, depending on the last column in "Source.docx".

What I got so far in my code below:


1. Create both mail merged documents (green and red)

2. Split the date in the master tables last row (left and right cell) ---> Call SplitDate()


3. Insert NewRows for all the Names ("eigene Berater") in master tables row 14 ff ---> NewRowsAJ()

Column 4 in Source.docx has to be splitted into:
a) Row 14 f for every name before "(Federführung)" or "(gemeinsame Federführung)"

b) 18 ff for every name behind "(Federführung)" or "(gemeinsame Federführung)"

In the master/mailmerged documents it is not allowed to write two or more names together in one row, so I have to split a) and b) itself have to into seperate rows for each name.



4. Replace Section Breasks that were created from words mail merge --->Call ReplaceSectionBreaks()


5. Insert all tables in the final document to be submitted.





Number 3 is my problem because its not working reliable and I dont know why -.-
Thats why I want o replace that step with a Mergfield function to split aftere each comma somehow....



Code:
Sub test()
'
'
'
'master1.docx =green table is open:::::::::

    ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        "C:\Users\.....\Source.docx", ConfirmConversions _
        :=False, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
        Connection:="", SQLStatement:="", SQLStatement1:="", SubType:= _
        wdMergeSubTypeOther
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With

      .Execute Pause:=False
    End With
'-----------------------------------------------------------------
'
Call SplitDate()
Call NewRowsAJ
Call ReplaceSectionBreaks


'--------------------------------------------------------------------
'::::SAVE
       
       ActiveDocument.SaveAs FileName:="C:\Users\.....\1.docx"
       ActiveWindow.Close
'------------------------------------------------------------------------    
'Master2=red table::::::::::
    Documents.Open FileName:="C:\Users\.....\Master2.docx"
    ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        "C:\Users\azem\Work Folders\Desktop\BDC\Legal500_Quelle.docx", ConfirmConversions _
        :=False, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
        Connection:="", SQLStatement:="", SQLStatement1:="", SubType:= _
        wdMergeSubTypeOther
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
       .Execute Pause:=False
    End With
    
'--------------------------------------------------------------------------

Call SplitDate()
Call NewRowsAJ
Call ReplaceSectionBreaks

'----------------------------------------------------------------------

'::::SAVE
       ActiveDocument.SaveAs "C:\Users\.......\2.docx"
       ActiveWindow.Close   
       

'Insert 1.docx (green tables) and 2.docx (red tables) in finalDoc at Boookmark's postion

Documents.Open FileName:="C:\Users.......\FinalDocument.docx"

ActiveDocument.Bookmarks("grün").Select

    Selection.InsertFile FileName:="C:\Users\.......\1.docx", Range:="", ConfirmConversions _
        :=False, Link:=False, Attachment:=False
    Selection.InsertFile FileName:="C:\Users\a.......\2.docx", Range:="", ConfirmConversions:= _
        False, Link:=False, Attachment:=False

End Sub

-------------------------------------------------------------------------------
Sub SplitDate()

Dim keyWord, data As String
Dim rowCount As Long
Dim splitArray() As String



keyWord = "Startdatum"
tableCount = ActiveDocument.Tables.count

For i = 1 To tableCount

rowCount = ActiveDocument.Tables(i).Rows.count

    For j = rowCount To 1 Step -1

        data = ActiveDocument.Tables(i).Cell(j, 1).Range.Text
        data = Replace(data, vbCr, "")
        data = Left(data, Len(data) - 1)

        If (data = keyWord) Then

            data = ActiveDocument.Tables(i).Cell(j + 1, 1).Range.Text
            data = Replace(data, vbCr, "")
            data = Left(data, Len(data) - 1)

            ''Variante VON XYZ BIS XYZ '''
            If (InStr(data, "-") > 0) Then
                splitArray() = Split(data, "-")
                ActiveDocument.Tables(i).Cell(j + 1, 1).Range.Text = splitArray(0)
                ActiveDocument.Tables(i).Cell(j + 1, 2).Range.Text = splitArray(1)
                Exit For
            End If
            '''
            ''Variante Fortlaufend
            If (data = "Fortlaufend") Then
                ActiveDocument.Tables(i).Cell(j + 1, 1).Range.Text = data
                ActiveDocument.Tables(i).Cell(j + 1, 2).Range.Text = ""
                Exit For
            End If
            '''
            ''Variante "seit XYZ"
            If (InStr(data, "eit") > 0) Then
                ActiveDocument.Tables(i).Cell(j + 1, 1).Range.Text = data
                ActiveDocument.Tables(i).Cell(j + 1, 2).Range.Text = ""
                Exit For
            End If
            '''
            ''Variante "bis XYZ"
            If (InStr(data, "bis") > 0) Then
                ActiveDocument.Tables(i).Cell(j + 1, 1).Range.Text = ""
                ActiveDocument.Tables(i).Cell(j + 1, 2).Range.Text = data
                Exit For
            End If
            ''Variante nur datum (Enddatum?)
            ActiveDocument.Tables(i).Cell(j + 1, 1).Range.Text = ""
            ActiveDocument.Tables(i).Cell(j + 1, 2).Range.Text = data
            Exit For
        End If
    Next
Next
End Sub

---------------------------------------------------------------------------------

Sub NewRowsAJ()
'only sometimes working :(
    Dim dataArray() As String
    Dim splitArray() As String
    Dim data As String
    Dim i, x, z, count, tableCount, lastIndex, lastCell, b, callY, preCell As Long
    
    'Anzahl der vorhandenen Zellen unter der Federführende etc., die mit Werte eingetragen werden kann.
    preCell = 3
    'Zählt die Tabellen durch.
    tableCount = ActiveDocument.Tables.count

'Loop durch die Tabellen.
For i = 1 To tableCount
    
    callY = 14
    'Holt sich den langen String aus der Zelle.
    data = ActiveDocument.Tables(i).Cell(callY, 1).Range.Text
    
    'Absatz/Zeilenumbruch abfangen...
    data = Replace(data, vbCr, "")
    data = Left(data, Len(data) - 1)

    'Großer String wird geteilt.
    dataArray = Split(data, "(")
      
    'Split1 wird aufgeteilt, Spalten zugewiesen und reingeschrieben.
    splitArray = Split(dataArray(0), ", ")
    lastIndex = UBound(splitArray) + 1
    If lastIndex > preCell Then
    For z = 3 To lastIndex
        For count = 1 To 3
            ActiveDocument.Tables(i).Cell(callY, count).Range.Cells.Split NumRows:=2, NumColumns:=1, MergeBeforeSplit:=False
        Next
    Next
    End If
    
    For z = 0 To lastIndex - 1
        ActiveDocument.Tables(i).Rows(callY).Height = 9.75
        ActiveDocument.Tables(i).Cell(callY, 1).Range.Text = splitArray(z)
        callY = callY + 1
    Next
    If UBound(splitArray) = 0 Then
        callY = callY + 1
    End If
    
    'Abfrage ob der große String gesplittet wurde.
    If UBound(dataArray) = 1 Then
        callY = callY + 2
   
'Split2 wird aufgeteilt, Spalten zugewiesen und reingeschrieben.
        splitArray = Split(dataArray(1), ", ")
        lastIndex = UBound(splitArray)
        If UBound(splitArray) = 0 Then
        callY = callY + 1
        End If
        
        For z = 2 To lastIndex
            For count = 1 To 3
            ActiveDocument.Tables(i).Cell(callY, count).Range.Cells.Split NumRows:=2, NumColumns:=1, MergeBeforeSplit:=False
            Next
        Next
        
        For z = 1 To lastIndex
            ActiveDocument.Tables(i).Rows(callY).Height = 9.75
            ActiveDocument.Tables(i).Cell(callY, 1).Range.Text = splitArray(z)
            callY = callY + 1
        Next
    End If
Next
End Sub


-----------------------------------------------------------------------------

Sub ReplaceSectionBreaks()
    'reliably replace section breaks with page breaks
    'even if they're followed by tables
    Dim rg As Range
    Set rg = ActiveDocument.Range
    With rg.Find
        .Text = "^b"
        .Wrap = wdFindStop
        While .Execute
            rg.Delete
            rg.InsertBreak Type:=wdPageBreak
            rg.Collapse wdCollapseEnd
        Wend
    End With
End Sub
Attached Files
File Type: docx Source.docx (41.1 KB, 6 views)
File Type: docx Master.docx (40.9 KB, 6 views)
Reply With Quote
  #4  
Old 06-13-2022, 05:59 PM
macropod's Avatar
macropod macropod is offline Split Data from Mergefield into seperate rows Windows 10 Split Data from Mergefield into seperate rows Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

It seems to me you're trying to deal with the problem from the wrong end. It would be far simpler to correct the data before merging. Try the following macro on your source document:
Code:
Sub SourceTableReformat()
Application.ScreenUpdating = False
Dim r As Long, x As Long, y As Long, Rng As Range, StrTxt As String
With ActiveDocument.Tables(1)
  For r = .Rows.Count To 2 Step -1
    With .Rows(r)
      StrTxt = Split(.Cells(4).Range.Text, vbCr)(0)
      x = UBound(Split(StrTxt, ","))
      If x > 0 Then
        Set Rng = .Range
        For y = 1 To x - 1
          Rng.Collapse wdCollapseEnd
          Rng.FormattedText = .Range.FormattedText
          Rng.Cells(4).Range.Text = Trim(Split(StrTxt, ",")(y))
        Next
        .Cells(4).Range.Text = Trim(Split(StrTxt, ",")(0))
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Split Data from Mergefield into seperate rows Delete blank table rows in merged document and split document in docx and pdf based on excel rows Alex1s85 Word VBA 5 05-22-2021 12:05 PM
Split data in cells and duplicate rows ballpoint Excel Programming 6 02-07-2018 05:52 PM
Split Data from Mergefield into seperate rows Blank Rows in Table populated through Conditional IF statemement MergeField options in Word gideonpm Mail Merge 3 12-22-2016 01:20 PM
Macro Winword mailmerge split printpage with mergefield as filename pca Word VBA 2 02-28-2014 02:43 PM
Can I do this? sorting data in seperate columns shumonsaha Excel 0 07-04-2010 03:05 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 12:52 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft