Consulting

Results 1 to 5 of 5

Thread: Transfer results from Excel to Word

  1. #1
    VBAX Regular
    Joined
    Dec 2019
    Posts
    23
    Location

    Transfer results from Excel to Word

    I have an excel workbook that passes details of members to a word document. The current code all works fine and passes the names to a series of columns in a table within a word document. Each member has four pieces of information passed across - membership number, title, first name and last name - so taking up 4 columns. The table has 9 columns so each row has two members details with the central column left blank. The information is passed a row at a time in alphabetical order. The code used is below.

    What I am trying to achieve is to change it so the member details are pasted down a page (using columns 1-2-3-4) and then at the foot of the first page it starts at the top of that same page leaving column 5 blank and pasting the next name alphabetically down the page (using columns 6-7-8-9). Once that A4 page is full it starts on the next page.

    Any help adjusting the code would be hugely appreciated.

    ub XLWordCurrentMembers()
    'xl transfer to different sheet and then different sheet to Word table
    Dim WrdApp As Object, FileStr As String, Arr2() As Variant, RowCnt As Integer
    Dim WrdDoc As Object, TblCell As Variant, Temp As Double, Cnt4 As Integer
    Dim Lastrow As Integer, Cnt As Integer, Cnt2 As Integer, CntA As Integer, Cnt3 As Integer
    Dim ARR() As Variant, Lastrow2 As Integer, LastCol As Integer, rng As Range
    ' clear old sheet
    Sheets("CurrentMembers").Rows("1:" & Sheets("CurrentMembers").Rows.Count).ClearContents
    'set #rows & #columns for transfer
    With Sheets("Membership")
    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    'load transfer rows as ranges to array(1)
    ReDim ARR(Lastrow)
    With Sheets("Membership") '
    For Cnt = 1 To Lastrow
    If .Cells(Cnt, 24).value = "renewed" Then
    CntA = CntA + 1
    ReDim Preserve ARR(CntA)
    Set rng = .Range(.Cells(Cnt, 1), .Cells(Cnt, LastCol))
    ARR(CntA - 1) = rng
    End If
    Next Cnt
    End With
    'transfer array(1) ranges to different sheet below lastrow
    With Sheets("CurrentMembers")
    For Cnt2 = LBound(ARR) To UBound(ARR) - 1
    If .Range("B" & 1).value = vbNullString Then
    Lastrow2 = 0
    Else
    Lastrow2 = .Range("B" & .Rows.Count).End(xlUp).Row
    End If
    .Range(.Cells(Lastrow2 + 1, "B"), .Cells(Lastrow2 + 1, LastCol + 1)) = ARR(Cnt2)
    Next Cnt2
    End With
    'load 4 columns of different sheet to array(2) for tranfer to Word
    Lastrow2 = Lastrow2 + 1
    ReDim Arr2(Lastrow2, 4)
    For Cnt3 = 1 To 4
    For Cnt4 = 1 To Lastrow2
    Arr2(Cnt4 - 1, Cnt3 - 1) = Sheets("CurrentMembers").Cells(Cnt4, Cnt3 + 1)
    Next Cnt4
    Next Cnt3
    
    
    FileStr = "F:\FullMembershipList\\wordDoc\CurrentMembers.docx" '********** change address to suit
    'determine number of Word table rows (x2 sheet ranges/rows from array(2) per table row)
    Temp = WorksheetFunction.RoundUp((Lastrow2 / 2), 0)
    On Error GoTo ErFix
    'open existing Word doc
    Set WrdApp = CreateObject("Word.Application")
    WrdApp.Visible = False
    Set WrdDoc = WrdApp.Documents.Open(FileStr)
    With WrdDoc
    'clear doc
    .Range(0, .Characters.Count).Delete
    'add table and header
    .tables.Add WrdApp.Selection.Range, NumRows:=Temp + 1, NumColumns:=9
    .tables(1).cell(1, 1).Range = "Number"
    .tables(1).cell(1, 2).Range = "Title"
    .tables(1).cell(1, 3).Range = "First"
    .tables(1).cell(1, 4).Range = "Last"
    .tables(1).cell(1, 6).Range = "Number"
    .tables(1).cell(1, 7).Range = "Title"
    .tables(1).cell(1, 8).Range = "First"
    .tables(1).cell(1, 9).Range = "Last"
    'fill table from array(2)
    For Cnt4 = 0 To Lastrow2 - 1
    RowCnt = RowCnt + 1
    For Cnt3 = 0 To 3
    .tables(1).cell(RowCnt + 1, Cnt3 + 1).Range = Arr2(Cnt4, Cnt3)
    .tables(1).cell(RowCnt + 1, Cnt3 + 6).Range = Arr2(Cnt4 + 1, Cnt3)
    Next Cnt3
    Cnt4 = Cnt4 + 1
    Next Cnt4
    End With
    WrdApp.ActiveWindow.View.TableGridlines = True
    'close, save, quit Word and clean up
    WrdApp.ActiveDocument.Close savechanges:=True
    Set WrdDoc = Nothing
    WrdApp.Quit
    Set WrdApp = Nothing
    MsgBox "Finished sorting Data.  Open the MS Word document 'CurrentMembers.docx' for list to be printed"
    Exit Sub
    ErFix:
    On Error GoTo 0
    MsgBox "error"
    Set WrdDoc = Nothing
    WrdApp.Quit
    Set WrdApp = Nothing
    End Sub

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    This would be a trivial undertaking using a label mailmerge - without ever needing to open the Excel workbook, let alone any VBA - using a two-column page layout with a 4-column table snaking from the top of one column to the bottom of the next and a suitably-sized column spacing in between.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    VBAX Regular
    Joined
    Dec 2019
    Posts
    23
    Location
    Quote Originally Posted by macropod View Post
    This would be a trivial undertaking using a label mailmerge - without ever needing to open the Excel workbook, let alone any VBA - using a two-column page layout with a 4-column table snaking from the top of one column to the bottom of the next and a suitably-sized column spacing in between.

    But the data is held in an excel workbook, updated, added to and stored in that environment. Excel is then used to sort the data required that then feeds into the word document. Hence the desire to keep it in this form. It is a charitable organisation run entirely by volunteers hence the desire to keep things as automated as possible and avoid spending time producing each month. (The output list of members produced is issued each month and currently that is simply done by pushing a button in excel, opening results Word document and printing a hard copy; only issue is it is not in the best format for its then intended use.)

    I am not an expert in Word and certainly do not use mailmerge. If you are saying I can easily transpose the data from current Word output to required output in a very simple way then I'd love to know more.

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by krackers View Post
    But the data is held in an excel workbook, updated, added to and stored in that environment
    . Excel is then used to sort the data required that then feeds into the word document
    .
    ...
    I am not an expert in Word and certainly do not use mailmerge. If you are saying I can easily transpose the data from current Word output to required output in a very simple way then I'd love to know more.
    That is precisely what mailmerge is for - taking data from, for example, Excel and outputting it in Word.

    See:
    https://support.office.com/en-gb/art...f-932c49474705
    https://support.microsoft.com/en-gb/...-to-print-form
    https://support.office.com/en-us/art...B-0A948FA3D7D3
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    VBAX Regular
    Joined
    Dec 2019
    Posts
    23
    Location
    Thanks macropod. After a bit of reading and thinking, I have managed to use mailmerge to create what I am after, many thanks. In order to get things exactly as I wanted, I had to create a table for the mailmerge and then create two columns in the word document to get it to repeat on the page. It was this second column aspect that took me a while to realise as the way forward and to achieve what I was after. That's because I am a relative novice when it comes to word! But after all the hunting and reading I now also know and understand a lot more about 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
  •