CODEWITHSUNDEEP
excelvbams-word
Charlotte
Charlotte

Reputation: 423

Insert text to Word from Excel looping through drop down list

I would like to populate a Word template with 3 numbers from an Excel table column for each Region in the drop down list (I simplified the task in this example). The template is very simple as follows: For Region 1, on June, 21 the estimate was "D6" and the volume was "D7" and the variance was "D8 (in percentage)". Please see image below.

Explanation:

I have 3 options (Regions) in the drop-down list and for every option the values in the table change. I need the numbers in the column to be copied for every Region in the drop down list (Region 1, Region 2, Region 3) and they should be copied in a in the same Word document, one paragraph below the other, one for Region 1, one for Region 2 etc. (see template above).

The value in D2 is changed manually depending on the week and for example if the value in D2 is 14 it should insert the numbers in column C etc.

Note 1: I tried to use mail merge but it is not possible with the drop down list and the format of my data.

Excel

Below is the code I got so far. The code was heavily inspired from the answer of this question: Excel-VBA; Copy data from excel and paste it in to a word template at different places

I am new to VBA and so far I only figured out how to insert text from one Region and I would need to do the task for three Regions to get three paragraphs.

Sub PasteStuffIntoWord()
Dim ws As Worksheet
Dim TextToPaste As String
Dim objWord As Object
Dim objSelection As Object

Set ws = Worksheets("Sheet1")
With ws
    TextToPaste = " For Region 1, on June, 21 the estimate was " & .Range("D6").Text & _
    " and the volume was " & .Range("D7").Text & _
    " and the variance was  " _
    & .Range("D8").Text
End With

    Set objWord = CreateObject("word.Application")
    objWord.Documents.Open "C:Test.docx"
    objWord.Visible = True
    Set objSelection = objWord.Selection
    objSelection.TypeText TextToPaste

End Sub

Upvotes: 0

Views: 177

Answers (1)

Алексей Р
Алексей Р

Reputation: 7627

Try this code:

Option Explicit

Sub Export()
    Dim objWord As Object, doc As Object, reg As Variant
    
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True  'optional, but better not
    
    With ThisWorkbook.Sheets("Sheet 1")
        For Each reg In Array("Region1", "Region2", "Region3")
            .Range("B3") = reg
            .Calculate
            
            Set doc = objWord.Documents.Add 'Open("C:\Test.docx")
            
            doc.Range.Text = " For Region 1, on June, 21 the estimate was " & .Range("D6").Text & _
            " and the volume was " & .Range("D7").Text & _
            " and the variance was  " _
            & .Range("D8").Text
            
            doc.SaveAs "C:\temp\" & reg & ".docx"  ' your path and name
            doc.Close False
        Next
    End With
    
    objWord.Quit
End Sub

Edit2

Sub Export()
    Dim reg As Variant, col As String, txt As String
    
    With ThisWorkbook.Sheets("Sheet 1")
        For Each reg In Array("Region1", "Region2", "Region3")
            .Range("B3") = reg
            .Calculate
            
            col = IIf(.Range("D2").Value = 14, "C", "D")    'select column due to D2 value
            
            ' collect all texts in txt
            txt = txt & vbTab & "For " & reg & ", on June, 21 the estimate was " & _
            .Range(col & "6").Text & " and the volume was " & .Range(col & "7").Text & _
            " and the variance was  " & .Range(col & "8").Text & vbLf
        Next
    End With
    
    With CreateObject("Word.Application").Documents.Add
        .Range.Text = txt    ' output all text to the document
        .SaveAs "C:\temp\AllTheText.docx"  ' your path and name
        .Parent.Quit    'quit Word
    End With
End Sub

Upvotes: 1

Related Questions