1

Scenario: I have a spreadsheet used for generating letters via an automated mail merge macro. The spread typically contains about 2000 rows

Problem: I need to have the ability to create letters using 2 different letter templates based on cell values in a column. In the example below, the value on column C should dictate which letter template will be used for each row.

Example

      Col A        Col B            Col C
      John         Smith           YES           Letter Template 1 to be used
      Joe            Henricks      No            Letter Template 2  to be used
       Mark        Jones            YES          Letter Template 1  to be used

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Here is some VBA I was playing with but can't quite get it working for the 2 different letters.

I've also tried using IF, THEN, ELSE statements but still can't get it working

   Sub CommandButton2_Click()

   Selection.AutoFilter   '''''''''' This should filter all rows based on the YES value 
    ActiveSheet.Range("D1:AH1").AutoFilter Field:=31, Criteria1:= _
    "YES"

     '''''''''''''''''''''''''''''''''''''''''

   Dim WordApp As Object
   Dim rng As Range
   Range("A1:H1").Select

    Set rng = Application.Intersect(ActiveSheet.UsedRange, Range("D1:AH1"))
    rng.SpecialCells(xlCellTypeVisible).Select


   On Error Resume Next
   Set WordApp = GetObject(, "Word.Application")
   On Error GoTo 0

   If WordApp Is Nothing Then
   Set WordApp = CreateObject("Word.Application")
   End If
    ''' This should run the macro using the YESletter Template
           WordApp.Visible = False
   WordApp.Documents.Open "\\....\docs\lg\Letterbuilder\YESletter.docm""
   WordApp.Run "Module1.SaveIndividualWordFiles"


   '''''''''''''''''''''''''''''''''''''''''

   Selection.AutoFilter   '''''''''' This should filter all rows        based        on        the NO value 
ActiveSheet.Range("D1:AH1").AutoFilter Field:=31, Criteria1:= _
    "Post"

   '''''''''''''''''''''''''''''''''''''''''

   On Error Resume Next
   Set WordApp = GetObject(, "Word.Application")
   On Error GoTo 0

   If WordApp Is Nothing Then
   Set WordApp = CreateObject("Word.Application")
   End If

    ''' This should run the macro using the NOletter Template
           WordApp.Visible = False
   WordApp.Documents.Open "\\....\docs\lg\Letterbuilder\NOletter.docm"
   WordApp.Run "Module1.SaveIndividualWordFiles"

   End

Here's the IF, THEN, ELSE statement method

   If ThisWorkbook.Sheets("LetterData").Range("AH").Value = "YES" Then

       WordApp.Visible = False
   WordApp.Documents.Open "\\....\docs\lg\Letterbuilder\YESletter.docm"
   WordApp.Run "Module1.SaveIndividualWordFiles"

   ELSE

       WordApp.Visible = False
   WordApp.Documents.Open "\\....\docs\lg\Letterbuilder\NOletter.docm"
   WordApp.Run "Module1.SaveIndividualWordFiles"

   End
Improve this question

1 Answer 1

Reset to default
1

there are some major flaws in your code:

  • to open a Word document with a given template you must use Documents object Add() method, instead of Open() one

  • Word templates documents have ".dot" or ".dotx" extension, instead of ".docm" I see in your code

  • set only one Word application and use it throughout your macro

    and eventually "dispose" it with

  • finally, never use End statement

    just use End Sub

so here follows a possible code:

Option Explicit

Sub CommandButton2_Click()
    Dim wordApp As Object

    Set wordApp = GetWordObject '<--| get a Word object
    If wordApp Is Nothing Then Exit Sub '<--| if no Word Object has been gotten then exit sub

    With ThisWorkbook.Sheets("LetterData") '<--| reference your letter worksheet
        With Application.Intersect(.UsedRange, Range("D1:AH1").EntireColumn) '<--| reference your data range as that in referenced worksheet columns D:H used range
            CreateWordDocuments .Cells, "YES", wordApp, "\\....\docs\lg\Letterbuilder\YESletter.dotx" '<--| process "YES" documents
            CreateWordDocuments .Cells, "NO", wordApp, "\\....\docs\lg\Letterbuilder\NOletter.dotx" '<--| process "NO" documents
        End With
        .AutoFilterMode = False '<--| show all rows back and remove autofilter
    End With

    '"dispose" Word
    wordApp.Quit True '<--| quit Word and save changes to open documents
    Set wordApp = Nothing
End Sub

Sub CreateWordDocuments(dataRng As Range, criteria As String, wordApp As Object, templateDocPath As String)
    Dim cell As Range
    With dataRng '<--| reference data range
        .AutoFilter Field:=31, criteria1:=criteria '<--| filter it on its column 31 with given criteria
        If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any cell has been filtered
            For Each cell In .Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) '<--| loop through filtered cells
                wordApp.Documents.Add templateDocPath '<-- open the passed Word template
                wordApp.Run "Module1.SaveIndividualWordFiles" '<--| run your macro
            Next cell
        End If
    End With
End Sub

Function GetWordObject() As Object
    Dim wordApp As Object

    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application") '<--| try getting a running Word application
    On Error GoTo 0
    If wordApp Is Nothing Then Set wordApp = CreateObject("Word.Application") '<--| if no running instance of Word has been found then open a new one

    Set GetWordObject = wordApp '<--| return the set Word application
    wordApp.Visible = False
End Function

BTW:

  • your data example mentions Col A, Col B and Col C, but your code uses a range form column "D" to "AH"

    I assumed this latter

  • your code has a statement with Criteria1:="Post"

    I assumed "YES" and "NO" as the only criteria

but all these aspects are easily settable in the proposed code

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

7 Comments

Thank you for you input. I appears to accomplish my goal however I do have a question. When I run the macro I get the following error on the line below. Any suggestion on a resolution? AutoFilter method of Range class failed 'code'.AutoFilter Field:=31, Criteria1:=criteria '<--| filter it on its column 31 with given criteria 'code'
check for dataRng to have been actually set a valid Range. So, climbing up the chain to it you must ensure that 1) the workbook where the macro resides in actually have a worksheet named after "LetterData" 2) "LetterData" worksheet has data in columns "D to AH" 3) "LetterData" worksheet column "AH" has a header
@user1839308, did you get through it?
Good Morning.... It seems like I'm close but not quite there yet. I posted an image under the answer section of this post. Hopefully it went through. That will provide more details . •I have confirmed that the LetterData sheet does contain a col named PrePost which is unde AH. •There are 2 samples (Row 2 and Row 3). In each row col AH contains the value of Pre and Post. •Do I need to define dataRng? •Do I need to define criteria().
@user1839308 please confirm that 1) the workbook where the macro resides in actually has a worksheet named after "LetterData". Moreover step through your code line by line (place cursor in any statement in CommandButton2_Click and press F8 repeatedly) and see when it errors out and tell me which line this is.
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.