Dynamically loop through validation drop-down list after each entity's Word document is created

kwallace20 · Jul 29th 2020

Hello,

Thank you in advance for any advice that may be offered!

Am working to assist a colleague with VBA;

Currently, the code works great to create a Word document (report) with an entity's relevant information with respect to data taken from selected cells and tables set up in Excel based upon validation drop-down box (Sheet "Table", column "B2").

The functionality that is lacking that we'd like to add is to have the drop-down box go to the next non-null value in a loop until all of the Word documents get created; for now, we manually advance to the next non-null value.

I have commented out what I have tried in terms of setting up a loop thus far; the loop goes through the drop-down box but does not generate each entities Word document.

Many thanks again,

Karen

'The purpose of the routine is to create a new Word document (report) for each entity

'The performance results and payment are pasted into the Word document and saved with a stamp of the entity name and generation date

'Currently, the drop down box must be manually clicked from sheet "Table" column "B2" to go to the next entity

Code

Sub MPMT_LoopTest1()


Worksheets("table").Activate


Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim table1 As Range
Dim HosName As Range
Dim ProjTite As Range
Dim Projdesc As Range
Dim ProjID As Range
Dim address1 As Range
Dim city As Range
Dim zip As Range


'KEW added 7/29/20
'Dim dvCell As Range
'Dim inputRange As Range
'Dim c As Range
'Dim i As Long


Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Add(Template:="C:\Users\<pathway>\letter KEW testing v1.docx", NewTemplate:=False, DocumentType:=0)
Set table1 = Range("a10:g15")
Set HosName = Range("b2")
Set address1 = Range("ad5")
Set city = Range("ad6")
Set zip = Range("ad7")


HosName.Select
Selection.Copy
WordApp.Visible = True
WordApp.ActiveDocument.Bookmarks("HosName").Select
Set objSelection = WordApp.Selection
objSelection.PasteSpecial DataType:=wdPasteText


address1.Select
Selection.Copy
WordApp.Visible = True
WordApp.ActiveDocument.Bookmarks("address1").Select
Set objSelection = WordApp.Selection
objSelection.PasteSpecial DataType:=wdPasteText


city.Select
Selection.Copy
WordApp.Visible = True
WordApp.ActiveDocument.Bookmarks("city").Select
Set objSelection = WordApp.Selection
objSelection.PasteSpecial DataType:=wdPasteText


zip.Select
Selection.Copy
WordApp.Visible = True
WordApp.ActiveDocument.Bookmarks("zip").Select
Set objSelection = WordApp.Selection
objSelection.PasteSpecial DataType:=wdPasteText


table1.Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
WordApp.Visible = True
WordApp.ActiveDocument.Bookmarks("table1").Select
Set objSelection = WordApp.Selection
objSelection.Paste


WordApp.ActiveDocument.SaveAs2 Filename:="C:\Users\<pathway>\" & HosName & " " & Format((Year(Now() + 1) Mod 100), "20##") & _
Format((Month(Now() + 1) Mod 100), "0#") & _
Format((Day(Now()) Mod 100), "0#") & "-report.docx"


'KEW added 7/29/20


'Which cell has data validation
'Set dvCell = Worksheets("Table").Range("B2")
'Determine where validation comes from
'Set inputRange = Evaluate(dvCell.Validation.Formula1)
'i = 1


'Begin loop
'Application.ScreenUpdating = False
'For Each c In inputRange
' dvCell = c.Value
' i = i + 1
'Next c
'End loop


'Application.ScreenUpdating = True


End Sub

Display More

**royUK** · Jul 30th 2020

Welcome to Ozgrid. Please take a few minutes to read the Forum Rules to understand how the Forum works. I will add Code Tags this time.

I cannot see why tou cannot do all this within Excel. Attach an example workbook.

kwallace20 · Jul 30th 2020

Roy,

Thank you very much.

Apologies for the oversight with the code not being in the correct format in the posting.

I have attached an example notebook with dummy data.

Much appreciation!

Regards,

Karen

**royUK** · Jul 30th 2020

Thanks. Can you attach an example of the word doc.

Why have you removed Option Explicit from your code? Using it has many advantages

kwallace20 · Jul 30th 2020

Roy,

Thank you - it's currently on letterhead...I can upload a Word doc with the bookmarks for the addresses, project and table placeholders if that helps.

Option Explicit - not sure why it was removed - I'll read the link and glad to have it added back!

Regards,

Karen

kwallace20 · Jul 30th 2020

Attaching Word document with bookmarks; thank you

**royUK** · Jul 30th 2020

I've just tested the code but there;s missing bookmarks, probably because you have set up a dummy doc.

I'm not quite sure what you mean about the drop down though.

kwallace20 · Jul 30th 2020

That's ok - I put in the most important bookmarks for the name, addresses and table 1 (others can be ignored - I could comment out).

The drop-down is the listing of all the hospitals (I only put 3 in the dummy list).

The way the code works currently is that you manually choose one hospital from the drop-down, run the macro, and populate/save one report for that hospital.

What would be good is if a mechanism could iterate through the columnar list of the hospitals to create each report in Word, save it, then move on to the next hospital until the max hospital is reached.

Sorry if that was unclear - this last point is the sticking point that I'm trying to accomplish; please let me know any other questions!

Thank you,

Karen

**royUK** · Jul 30th 2020

This code is probably better than what you have. It needs a corresponding Named Range in Excel to the Bookmark in Word. By that I mean the names must match. If the named range in Excel is empty it will be ignored.

Code

Option Explicit
Sub NamesToBookmarks()
Dim objWord As Object
Dim docWord As Object
Dim wb As Excel.Workbook
Dim xlName As Excel.Name
Dim Path As String


Set wb = ActiveWorkbook
Path = wb.Path & "\MyForm.dot" 'change the name


On Error GoTo ErrorHandler


'Create a new Word Session
Set objWord = CreateObject("Word.Application")


On Error GoTo ErrorHandler


'Open document in word
Set docWord = objWord.Documents.Add(Path)


'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) And xlName <> Empty Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
End If
Next xlName


'Activate word and display document
With objWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With


'Release the Word object to save memory and exit macro
ErrorExit:
Set objWord = Nothing
Exit Sub


'Error Handling routine
ErrorHandler:
If Err Then
MsgBox "Error No: " & Err.Number & "; There is a problem"
If Not objWord Is Nothing Then
objWord.Quit False
End If
Resume ErrorExit
End If
End Sub

Display More

kwallace20 · Jul 30th 2020

Thank you very much, Roy!

This code looks great - I will test it out now with some data.

Have a wonderful day and thanks again!

Karen

**royUK** · Jul 30th 2020

Post back if you need more help

kwallace20 · Jul 30th 2020

Roy,

As a follow-up, if the Named Range is "Hospital_Names", where does that explicitly go in the code provided?

Thank you,

Karen

**royUK** · Jul 30th 2020

You create the Named Ranges manually

kwallace20 · Jul 30th 2020

Right - I understand that; I was trying to test with a named range "Hospital_Names" for the first one that I created.

I wasn't clear in the code you sent where the range is explicitly declared; my trying isn't working.

I'll do some reading on the named ranges in VBA to familiarize; thank you,

Karen

**royUK** · Jul 30th 2020

The code loops through each Named Range in the worksheet, checks for a match in the word doc and if it exists it copies the contents to the word doc. If the range is empty it ignores it

**royUK** · Jul 31st 2020

T think this is what you were trying for.

Run the macro called Main. This will run through each choice in the Data Validation List and create the document for each one

Dynamically loop through validation drop-down list after each entity's Word document is created

Participate now!

Share

Tags

Users Viewing This Thread