Consulting

Results 1 to 5 of 5

Thread: Merge tables from multiple documents into one table

  1. #1

    Merge tables from multiple documents into one table

    I thought I'd use this opportunity to say hello and also to ask for advice. I used to program in Basic and Visual Basic ages ago but want to develop my knowledge and skills in VBA. The immediate problem I am trying to solve is as follows.

    1) I have a number of Word documents that contain tables in a consistent format with the following column headings: Date; Action; Who by. These contain chronologies of the actions taken by different organisations in a case that I am reviewing

    2) I want to merge these together into a combined table using the same format (i.e. columns headed Date; Action; Who by) in such a way that it also combines them into a single chronology. Hopefully the following will give some idea of what I want to do:

    Chronology 1
    DATE ACTION WHO BY
    1/1/2020 Visit to client at 10.30am GP
    3/1/2020 Repeat prescription written GP

    Chronology 2
    DATE ACTION WHO BY
    1/1/2020 Visit to client at 2pm Social Services
    5/1/2020 Telephone call to District Nurse Social Services

    Merger of chronology 1 and 2

    DATE ACTION WHO BY
    1/1/2020 Visit to client at 10.30am GP
    1/1/2020 Visit to client at 2pm Social Services
    3/1/2020 Repeat prescription written GP
    5/1/2020 Telephone call to District Nurse Social Services

    3) Has anyone written any code that does something like this already? If so could anyone please point me in the right direction?

    Many thanks in advance

    Patrick

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Hey Patrick,
    Welcome to the best VBA resource on the Internet.

    Assuming that you want the result in Word, I moved this thread to the Word VBA forum
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Try running the following macro from an empty Word document (or at least one with no tables):
    Sub MergeChronologies()
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String, strTgt As String
    Dim wdDocTgt As Document, wdDocSrc As Document, Tbl As Table
    strFolder = GetFolder: If strFolder = "" Then Exit Sub
    Set wdDocTgt = ActiveDocument: strTgt = ActiveDocument.FullName
    strFile = Dir(strFolder & "\*.doc", vbNormal)
    While strFile <> ""
      If strFolder & strFile <> strTgt Then
        Set wdDocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
        With wdDocSrc
          For Each Tbl In .Tables
            wdDocTgt.Range.Characters.Last.FormattedText = Tbl.Range.FormattedText
          Next
          .Close SaveChanges:=False
        End With
      End If
      strFile = Dir()
    Wend
    With wdDocTgt.Tables(1)
      .SortAscending
      Do While InStr(1, .Cell(2, 1).Range.Text, "date", vbTextCompare) > 0
        .Rows(2).Delete
      Loop
    End With
    Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
    Application.ScreenUpdating = True
    End Sub
     
    Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
    End Function
    Simply select the folder containing the files to process and all tables in those documents will be merged. Do note it is not practical to sort on your second column's times, as the data there are too mixed to guarantee a reliable sorting.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  4. #4

    Thanks!

    Hi Macropod,

    That's absolutely brilliant, thanks so much. After a bit of finding the right folder it worked perfectly. My task now is to make it run on Word on a MacBook.

    Regards,

    Patrick

  5. #5
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    For a Mac, you might be able to use something like the following to select the files to process:
    Sub MergeChronologies()
    Application.ScreenUpdating = False
    Dim strSrc As String, strTgt As String, i As Long
    Dim wdDocTgt As Document, wdDocSrc As Document, Tbl As Table
    Set wdDocTgt = ActiveDocument: strTgt = ActiveDocument.FullName
    With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
      .AllowMultiSelect = True
      .Filters.Add "Documents", "*.doc; *.docx; *.docm", 1
      .InitialFileName = ""
      If .Show = -1 Then
        For i = 1 To .SelectedItems.Count
          strSrc = .SelectedItems(i)
          If strSrc <> strTgt Then
            Set wdDocSrc = Documents.Open(FileName:=strSrc, AddToRecentFiles:=False, Visible:=False)
            With wdDocSrc
              For Each Tbl In .Tables
                wdDocTgt.Range.Characters.Last.FormattedText = Tbl.Range.FormattedText
              Next
              .Close SaveChanges:=False
            End With
          End If
        Next
      Else
        GoTo ErrExit
      End If
    End With
    With wdDocTgt.Tables(1)
      .SortAscending
      Do While InStr(1, .Cell(2, 1).Range.Text, "date", vbTextCompare) > 0
        .Rows(2).Delete
      Loop
    End With
    ErrExit:
    Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
    Application.ScreenUpdating = True
    End Sub
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

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