Word vba conditional comdobox dropdown populated from excel - excel

The project is to reuse text previously written in reports where applicable for use in similar situations for future reports. They will of course have to be edited in detail.
The immediate challenge is to use a conditional combobox in ms_word vba to get data from ms-excel, lookup in one column, return response in next column.
The code below comes from:shorturl.at/rwMW3 It crashes at the first Set statement. Compile error: Syntax error.
This is the only code I have found for this application.
It crashes at the first Set statement. Compile error: Syntax error. Any help appreciated. I have of course entered the actual full path and sheet name.
Sub FillCCLsitWithExcelData()
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim i As Long
Dim subject As String
Dim bStart As Boolean
Dim ffield As FormField
Dim oCC As ContentControl
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then bStart = True
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlbook = xlapp.Workbooks.Open("D:\Data Stores\Data Source.xlsx")
  Set xlsheet = xlbook.Worksheets(1)
With xlsheet.Range("A1")
Set oCC =
ActiveDocument.SelectContentControlsByTitle("Names").Item(1)
 For i = 2 To .CurrentRegion.Rows.Count
    Debug.Print .Offset(i - 1, 0)
    oCC.DropdownListEntries.Add Text:=.Offset(i - 1, 0),
Value:=.Offset(i - 1, 0)
Next i
End With
xlbook.Close
If bStart = True Then xlapp.Quit
 End If
End Sub

Related

Pull particular Excel cell value into Word document using Word VBA

I am new to VBA and macros.
I got the repeated task of copy data from Excel and paste it in a particular location in the word document.
For example, my excel sheet has the data like this:
Col1
Col2
ID_1
I'm_One
ID_2
I'm_Two
ID_3
I'm_Three
Now i'm looking for a Word macro
Get text in Word table with cell position 3
Find the same text in Excel Col1
Get the value of Col2 from Excel
Paste the value of Col2 in word table with cell position 10
Repeat the same process for another table in Word document
[Update]
I have tried with multiple code snippets by google search but unable to construct the working macro.
Sub pull_from_Excel2()
'ref: https://www.macworld.com/article/211753/excelwordvisualbasic.html
Dim Month As String
ID_Range = "A2:A6" 'Select this as range like "A2:A16"
Offset_to_fetch = 1 'Select this to fetch comments etc. value starts with
Set xlSheet = GetObject("D:\Excel.xlsx")
'Snippets:
'Debug.Print VarType(xlSheet.Worksheets("Sheet1").Range("A3:A5").Value)
'8204
Dim Cell As Range, rng As Range
Debug.Print VarType(xlSheet.Worksheets("Sheet1").Range(ID_Range).Value2)
Set rng = xlSheet.Worksheets(1).Range(ID_Range)
For Each Cell In rng
Debug.Print Cell.Text
Next Cell
End Sub
I used this url to construct my skeleton code: https://www.macworld.com/article/211753/excelwordvisualbasic.html
When i try to get the values from the range of cells in excel, i got the following error for the code.
Set rng = xlSheet.Worksheets(1).Range(ID_Range).Value2
The above line gives "Object required" error when running.
Set rng = xlSheet.Worksheets(1).Range(ID_Range)
The above line gives "Type Mismatch" error when running.
Notes: For this error, I tried to use for each loop as this is array but the error is showing before executing the for loop.
Kindly assist.
I recommend to use Option Explicit and declare all your varibales properly. This way it is less likely that you end up with unseen errors.
To activate it for all new codes that you add in the future, you can activate it directly in Excel and Word. This is a good practice and will protect you from doing it wrong by notifying you of not declared variables:
In the VBA editor go to Tools › Options › Require Variable Declaration.
This will add Option Explicit to new modules only. In existing modules Option Explicit needs to be added manually as first line.
Further I highly recommend to name your variables according what they contain because otherwise it gets very confusing. You named your variable xlSheet but you load a workbook into it and not a worksheet.
The next issue is that your code is in Word and if you declare rng As Range then this is of type Word.Range and not Excel.Range and those are diffetent types so that is why you get a "Type Mismatch" error.
To solve this you either go in Word VBA to Extras › Refereces … and set a reference to the Excel library so you can declare your variable Dim xlRng As Excel.Range or if you don't set a reference you declare it as Object or Variant like in below example:
' This code is in Word!
Option Explicit
Public Sub pull_from_Excel2()
'declare constants
Const ID_Range As Sting = "A2:A6" 'Select this as range like "A2:A16"
Const Offset_to_fetch As Long = 1 'Select this to fetch comments etc. value starts with
Dim xlWorkbook As Object
Set xlWorkbook = GetObject("D:\Excel.xlsx") 'This expects the Excel to be already open! If not open you need to use CreateObject("Excel.Application")
Dim xlRng As Object
Set xlRng = xlWorkbook.Worksheets(1).Range(ID_Range)
Dim xlCell As Object
For Each xlCell In xlRng
Debug.Print xlCell.Text
Next xlCell
End Sub
Note if your workbook Set xlWorkbook = GetObject("D:\Excel.xlsx") is not open in Excel you need to use CreateObject("Excel.Application") and open it.
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Dim xlWorkbook As Object
Set xlWorkbook = xlApp.Workbooks.Open(FileName:="D:\Excel.xlsx") 'will open the workbook
xlApp.Visible = True 'make it false to open Excel invisible in the background
'your code here …
'in the end close workbook and Excel (espaciall if you had it invisible!)
xlWorkbook.Close SaveChanges:=False
xlApp.Quit 'close Excel
Option Explicit
Sub UpdateTables()
Const XLSX = "D:\Excel.xlsx"
Dim xlApp, wb, ws
Dim rngSearch, rngFound
Dim iLastRow As Long, n As Integer
' open spreadsheet
'Set xlApp = New Excel.Application
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set wb = xlApp.Workbooks.Open(XLSX, 1, 1)
Set ws = wb.Sheets(1)
iLastRow = ws.Cells(ws.Rows.Count, "A").End(-4162).Row 'xlUp
Set rngSearch = ws.Range("A2:A" & iLastRow)
' update tables
Dim doc As Document, tbl As Table, s As String
Set doc = ThisDocument
For Each tbl In doc.Tables
s = tbl.Cell(1, 1).Range.Text
s = Left(s, Len(s) - 2)
Set rngFound = rngSearch.Find(s, LookIn:=-4163, LookAt:=1) ' xlValues, xlWhole
If rngFound Is Nothing Then
MsgBox "'" & s & "' not found in table " & tbl.Title, vbExclamation
Else
tbl.Range.Cells(3).Range.Text = rngFound.Offset(0, 1)
n = n + 1
End If
Next
wb.Close False
xlApp.Quit
MsgBox n & " tables updated", vbInformation
End Sub

VB6 Missing DLL error when passing Excel object to function on some machines but works if not passed. why?

I can't figure out why some users (but not all) are seeing errors if I pass Excel to another function or sub with VB6.
This fails for some but not all. They get missing DLL or interface not registered error.
sub test()
Dim xl As Object, xlwbook As Object, xlsheet As Object
Set xl = CreateObject("excel.application")
Set xlwbook = xl.Workbooks.Add(xlWBATWorksheet)
xlwbook.Sheets("Sheet1").Name = "REPORT"
Set xlsheet = xlwbook.Sheets("REPORT")
Call formatlogo(xlsheet)
End Sub
function formatlogo(xlsheet As Worksheet)
xlsheet.Cells(1, 1).Characters(1, 1).Font.Name = "Webdings"
end function
This works for everyone.
sub test()
Dim xl As Object, xlwbook As Object, xlsheet As Object
Set xl = CreateObject("excel.application")
Set xlwbook = xl.Workbooks.Add(xlWBATWorksheet)
xlwbook.Sheets("Sheet1").Name = "REPORT"
Set xlsheet = xlwbook.Sheets("REPORT")
xlsheet.Cells(1, 1).Characters(1, 1).Font.Name = "Webdings"
End Sub
Why can't I pass an Excel object without dll errors for some folks?
Thank you in advance.

Graph portion of Excel table in Word with a macro

So for background, I get a excel workbook from another department that is full of a information for a specific account that I then take and use certain parts to create graphs in word. Is there a way I could create a macro what would grab the data from Ex. C22:H34, put it into a template word document and possibly auto populate the graphs as well? I want to make it a process that I can hand off to other people to do, so the simpler it is to execute, the better.
Here is what I have
Sub AutoNew()
'
' AutoNew Macro
'
'
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim bstartApp As Boolean
Dim i As Long
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
bstartApp = True
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlbook = xlapp.Workbooks.Open("C:\Users\MattsonC\Documents\work\Copy of
3202_2018_Renewal Rate Workbook v2 EDIT.xlsx")
Set xlsheet = xlbook.Sheets(1)
With xlsheet.Range("A1")
For i = 1 To .CurrentRegion.Rows.Count - 1
ActiveDocument.Variables(.Offset(i, 0)).Value = .Offset(i, 2)
Next i
End With
xlbook.Close
If bstartApp = True Then
xlapp.Quit
End If
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
ActiveDocument.Range.Fields.Update
End Sub
I have variables done like {DOCVARIABLE LLY} in all the places I want data to go in the template, and renamed the cells in excel with the same variable name.
I can't get any output to happen in my Word document, any suggestions?
Thank you!
go back to the beginning
insert a document variable in a new word document using following sequence (word 2016)
insert tab … text … quick parts … field … categories: document automation … field names: docVariable … put in variable name xxxx
then run this code
Sub aaa()
'ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes ' toggle field code view
Stop
ActiveWindow.View.ShowFieldCodes = True
Stop
ActiveWindow.View.ShowFieldCodes = False
ActiveDocument.Variables("xxxx").Value = "abc123"
ActiveDocument.Range.Fields.Update
Stop
ActiveDocument.Variables("xxxx") = "xyz987"
ActiveDocument.Fields.Update
End Sub
if that works, then use the code with the document that you are having trouble with and figure out if your field names are what you think they are

Find value in Excel from Outlook

I am having trouble performing an Excel vlookup from Outlook.
Here is what I am trying to accomplish:
- loop through each email in inbox
- if the subject line meets a criteria then get value
- go into excel and vlookup that value
- if the value exists, activate the cell and shift over to get the text value of the adjacent cell and bring it back to outlook to insert in an email (not there yet).
This is the code I'm stuck on (keep getting the 'object required' error):
Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
.
Dim result As String
result = Right(subject, 7)
Dim found As Boolean 'can this be boolean?I just want to know if its exists or not
found = objExcel.WorksheetFunction.VLookup(result, Sheet1.Range("A:A"), 1, False)
I thought the objExcel would replace the 'Application' as that would default to Outlook.
I do want to mention, I have code that will open the excel file and loop through each email to get the subject line value successfully but I just cant seem to get control of it to perform functions.
Update - I tried this and it worked BUT the value was set to false when It should be true. Can you confirm this is correct?
Dim wrksht As Object
Set wrksht = objExcel.ActiveWorkbook.Sheets("Sheet1")
Dim res As Boolean
sourceWB.Activate
With objExcel
res = Not IsError(objExcel.Match(result, wrksht.Range("A:A"), 0))
End With
You can use Match if you just want to check if something exists.
Note: if you drop the WorksheetFunction then you can test the return value to see if it's an error: if you include WorksheetFunction then your code will generate a run-time error in the event there's no match.
Dim objExcel As Object, wb As Object, sht As Object
Dim result As String, found As Boolean
Set objExcel = CreateObject("Excel.Application")
'
'
Set wb = objExcel.Workbooks.Open("path_goes_here.xlsx")
Set sht = wb.Sheets(1) 'or use the sheet tab name
'
result = Right(subject, 7)
found = Not IsError(objExcel.Match(result, sht.Range("A:A"), 0))
EDIT: if you want a corresponding value from another column then you could do this -
Dim m, answer
result = Right(subject, 7)
m = objExcel.Match(result, sht.Range("A:A"), 0)
If Not IsError(m) Then
answer = sht.Cells(m, "B").Value
Else
answer = "Not found!"
End If
I decided to use the following:
For Each cell In objExcel.Range("A:A")
If CStr(cell) = result Then
.
.
.
thanks #TimWilliams for working with me on this!!
here is a full example
Sub vLookup()
Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Dim xlWB As Object
Set xlWB = objExcel.Workbooks.Add
Dim xlSheet As Object
Set xlSheet = xlWB.Sheets("Sheet1")
Dim formula As String
Dim result As String
xlSheet.Range("a3") = "abc123"
xlSheet.Range("a4") = "abc"
xlSheet.Range("a5") = "123"
Stop ' press F8 to single-step from here
result = "abc123" ' this will be found
formula = "IFNA(MATCH(""" & result & """,A:A,0),0)" ' cell formula: =IFNA(MATCH("abc123",A:A,0),0) return 0 if not found
Debug.Print objExcel.Evaluate(formula) ' returns 3 in this example
' press ctrl-G to see output of Debug.Print
result = "aaa" ' this will not be found
formula = "IFNA(MATCH(""" & result & """,A:A,0),0)" ' cell formula: =IFNA(MATCH("aaa",A:A,0),0) return 0 if not found
Debug.Print objExcel.Evaluate(formula) ' returns 0 in this example
Set xlSheet = Nothing
Set xlWB = Nothing
Set objExcel = Nothing
End Sub

How to retrieve data from Excel and add to Word

I have a Word template file that retrieves data from an Excel file to populate a form.
The code looks something like this:
Dim myXL As Object
Set myXL = Getobject("myfile.xls")
myXL.Application.Visible = True
myXL.Parent.Windows(1).Visible = True
This code works fine in Office 2010 and 2007, but when I try it in 2013, it gives run time error 9 which is an array subscript error. When I check the Windows array it has zero elements, so error is correct.
How do I achieve the same result in 2013?
The next bit of code attempts to access the Worksheets("mysheet") and if I skip the Visible = True line accessing the worksheet gives runtime error 1004.
Any help with fixing this would be greatly appreciated.
To make the code work on Office 2013 I added the line myXL.Activate before trying to make the Window visible. So the code becomes:
Dim myXL As Object
Set myXL = Getobject("myfile.xls")
myXL.Application.Visible = True
myXL.Activate
myXL.Parent.Windows(1).Visible = True
This fixed the run-time error, and the code went back to working well.
To retrieve data from an Excel
An Example would be...
Option Explicit
Sub ExcelData()
Dim xlApp As Object ' Application
Dim xlBook As Object ' Workbook
Dim xlSht As Object ' Worksheet
Dim FilePath As String
FilePath = "C:\Temp\Book1.xlsx"
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(FilePath)
Set xlSht = xlBook.Sheets("Sheet1")
With ActiveDocument
.Content = xlSht.Range("A1").Value
End With
xlApp.Visible = True
Set xlApp = Nothing
Set xlBook = Nothing
End Sub

Resources