printing array only resulting in first value being printed into excel?

Question

Assigning word document lines of text to an array to then print into an excel column. I want to print each item in array to it's own cell.

Currently, all the items are storying correctly into the array, but it's only printing the first item over and over Action

Code:

Option Explicit
Sub ParaCopy()
    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Set wApp = CreateObject("Word.Application")
    Set wDoc = wApp.Documents.Open("J:\Data Dictionary.docx", ReadOnly:=True)

    Dim wPara As Word.Paragraph
    Dim arr() As Variant
    Dim i As Long
    i = 0
    For Each wPara In wDoc.Paragraphs
        If wPara.Range.Words.Count > 1 Then
            ReDim Preserve arr(i)
            arr(i) = wPara.Range
        End If
        i = i + 1
    Next wPara
    For i = LBound(arr) To UBound(arr)
        [a1].Resize(UBound(arr) + 1) = arr
    Next i
    
End Sub

EDIT: Need to separate each block of text separated by a space (outlined in blue) to this

[a1].Resize(UBound(arr) + 1) = application.Transpose(arr) you are putting a horizontal array in a vertical space. — Scott Craner
– Scott Craner, Commented Apr 22, 2021 at 22:17
you data is probably too big for application.Transpose then. Make the array a 2D array with one column and then paste that. — Scott Craner
– Scott Craner, Commented Apr 22, 2021 at 22:22

Scott Craner · Accepted Answer · 2021-04-30 20:28:42Z

3

Create a 2D array with one column and load that:

Option Explicit
Sub ParaCopy()
    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Set wApp = CreateObject("Word.Application")
    Set wDoc = wApp.Documents.Open("J:\Data Dictionary.docx", ReadOnly:=True)

    Dim wPara As Word.Paragraph
    Dim arr() As Variant
    ReDim arr(1 To wDoc.Paragraphs.Count, 1 To 1)
    Dim i As Long
    i = 1
    For Each wPara In wDoc.Paragraphs
        If wPara.Range.Words.Count > 1 Then
            arr(i, 1) = wPara.Range
            i = i + 1
        End If
        
    Next wPara

    [a1].Resize(UBound(arr) + 1) = arr
    
End Sub

edited Apr 30, 2021 at 20:28

answered Apr 22, 2021 at 22:26

Scott Craner

154k10 gold badges52 silver badges88 bronze badges

Sign up to request clarification or add additional context in comments.

Comments

VBasic2008 · Accepted Answer · 2021-04-23 01:24:31Z

1

Copy Word Paragraphs to Excel Cells Using an Array

The number of rows of the array is wDoc.Paragraphs.Count which may differ from r (the 'actual count') hence you have to use r with Resize, and not wDoc.Paragraphs.Count or UBound(Data, 1).
Don't forget to Close the Document and Quit the App.
The first solution is early-bound and needs the library reference. When using it, just use
Set wApp = New Word.Application.
The second solution is late-bound and doesn't need the library reference. Also, it has been 'stripped off' the document and application variables (not necessary, you can declare them As Object).

Option Explicit

' e.g. Tools>References>Microsoft Word 16.0 Object Library
Sub ParaCopy()
    
    Const FilePath As String = "J:\Data Dictionary.docx"
        
    Dim wApp As Word.Application: Set wApp = Set wApp = New Word.Application
    Dim wDoc As Word.Document: Set wDoc = wApp.Documents.Open(FilePath, , True)
    
    Dim Data As Variant: ReDim Data(1 To wDoc.Paragraphs.Count, 1 To 1)
    
    Dim wPara As Word.Paragraph
    Dim r As Long
    
    For Each wPara In wDoc.Paragraphs
        If wPara.Range.Words.Count > 1 Then
            r = r + 1
            Data(r, 1) = wPara.Range
        End If
    Next wPara
    
    wDoc.Close False
    wApp.Quit
    
    [a1].Resize(r) = Data
    
End Sub

Sub ParaCopyNoReference()
    
    Const FilePath As String = "J:\Data Dictionary.docx"
        
    With CreateObject("Word.Application")
        With .Documents.Open(FilePath, , True)
            Dim Data As Variant: ReDim Data(1 To .Paragraphs.Count, 1 To 1)
            Dim wPara As Object
            Dim r As Long
            For Each wPara In .Paragraphs
                If wPara.Range.Words.Count > 1 Then
                    r = r + 1
                    Data(r, 1) = wPara.Range
                End If
            Next wPara
            .Close False
        End With
        .Quit
    End With
    
    [a1].Resize(r) = Data
    
End Sub

edited Apr 23, 2021 at 1:24

answered Apr 23, 2021 at 1:04

VBasic2008

56.9k5 gold badges21 silver badges38 bronze badges

3 Comments

nick lanta Over a year ago

Will try this out soon, thank you! I do have a quick question. Would it be difficult to have the data print like this: whenever there is a space between paragraphs, print data into new column?

VBasic2008 Over a year ago

Try to post two screenshots to show before and after or ask a new question and add one of the codes and describe in detail what is wrong.

nick lanta Over a year ago

So I just uploaded the two pics describing what I was looking to do. Is this a simple edit or should I post a new question?

Collectives™ on Stack Overflow

printing array only resulting in first value being printed into excel?

2 Answers 2

Comments

Copy Word Paragraphs to Excel Cells Using an Array

3 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Copy Word Paragraphs to Excel Cells Using an Array

3 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related