Replacing an InputBox with a Userform (combobox)? - vba

Forgive my noob-ery. Assistance greatly appreciated!!!!
Purpose of macro: Fill in form in Microsoft Word with text originating in an Excel workbook from a specified worksheet.
My problem: Selecting said worksheet to draw that information from and integrating result into my code. Using an InputBox for now but would like to replace said InputBox with a UserForm with a ComboBox- giving pre-set choice for worksheet names (these never change).
I've created the UserForm with the choices. How do I get my code to initialize it? And how do I get my code to use the result from the ComboBox?
Sub Ooopsie()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim exSh As Excel.Worksheet
Dim strSheetName As String
Dim strDefaultText As String
strDefaultText = "sheet name here"
strSheetName = InputBox( _
Prompt:="The sheet name is?", _
Title:="Sheet Name?", _
Default:=strDefaultText _
)
If strSheetName = strDefaultText Or strSheetName = vbNullString Then Exit Sub
Set exWb = objExcel.Workbooks.Open("path to worksheet")
ActiveDocument.Tables(1).Rows(3).Cells(1).Range.Text = "Blah: " & exWb.Sheets(strSheetName).Cells(3, 3)
ActiveDocument.Tables(1).Rows(5).Cells(1).Range.Text = "blah blah : " & Chr(11) & "blah: " & exWb.Sheets(strSheetName).Cells(3, 1)
ActiveDocument.Tables(1).Rows(6).Cells(1).Range.Text = "Date de réception : " & Chr(11) & "Date Received : " & exWb.Sheets(strSheetName).Cells(3, 2)
ActiveDocument.Tables(1).Rows(7).Cells(1).Range.Text = "blah d : " & Chr(11) & "Deadline: " & exWb.Sheets(strSheetName).Cells(3, 4)
exWb.Close
Set exWb = Nothing
End Sub

I refined your code some. This should get you started. I reworked it to make it easier for you to see what's going on. Instead of opening an existing workbook I create a new workbook. I left the Inputbox in there with some error handling so you get an idea of what you should do. The code now right from the MS Word table to Excel.
Option Explicit
Private Sub CommandButton1_Click()
Dim xlApp, xlWB, xlWS
Dim strSheetName As String, strDefaultText As String
Dim tbl As Table
strDefaultText = "Sheet1"
strSheetName = InputBox( _
Prompt:="The sheet name is?", _
Title:="Sheet Name?", _
Default:=strDefaultText)
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Add
On Error Resume Next
Set xlWS = xlWB.WorkSheets(strSheetName)
If Err.Number <> 0 Then
MsgBox "Worksheet [" & strSheetName & " Not Found", vbCritical, "Action Cancelled"
xlWB.Close False
xlApp.Quit
Exit Sub
End If
On Error GoTo 0
xlApp.Visible = True
On Error Resume Next
If ActiveDocument.Tables.Count > 0 Then
Set tbl = ActiveDocument.Tables(1)
xlWS.Cells(3, 3) = tbl.Rows(3).Cells(1).Range.Text
xlWS.Cells(3, 1) = tbl.Rows(5).Cells(1).Range.Text
xlWS.Cells(3, 2) = tbl.Rows(6).Cells(1).Range.Text
xlWS.Cells(3, 4) = tbl.Rows(7).Cells(1).Range.Text
End If
Set xlWB = Nothing
Set xlApp = Nothing
End Sub
It is worth noting that you can't instantiate Excel from MS Word like this without a reference to the Microsoft Excel 12.0 I think is?
Dim objExcel As New Excel.Application
Use this instead
Dim objExcel as Variant
Set objExcel = CreateObject("Excel.Application")
I know that this is not a chat forum but I am open to opinions and advice. I am only a hobbist after all.
Update here is how one way add items to a combobox
For Each xlSheet In xlWB.Worksheets
ComboBox1.AddItem xlSheet.Name
Next

So you've created a form called UserForm1.
You can display it as a modal dialog using the default instance:
UserForm1.Show vbModal
But a better practice would be to instantiate it instead - forms are objects after all, so you can New them up like any other class module:
Dim view As UserForm1
Set view = New UserForm1
view.Show vbModal
You can add properties to your form's code-behind to expose values the calling code can use:
Public Property Get SheetName() As String
SheetName = ComboBox1.Text
End Property
So you can now write a function that does this:
Private Function GetSheetName() As String
Dim view As UserForm1
Set view = New UserForm1
view.Show vbModal
GetSheetName = view.SheetName
End Function
Now you can replace your InputBox call with a call to this GetSheetName function!
Of course you'll want to handle the case where the user cancels out of the form, but that's beyond the scope of this question, and... it's been asked on this site already, just search and you'll find!

Related

Automated Export of Access Table-Data to Populate Template Excel Sheet

I am working on exporting filtered table data from Access to an Excel sheet, yet I can only get the table data to export into new Excel files and not into template Excel files (with pre-made graphs to be populated).
I mainly have been using macros on Access to create a switchboard where the user presses a switchboard-button and the filtered data exports from a table in Access to a new Excel file in a Reports folder. I do not know that macros are able to export with template Excel files, so I have turned to learning VBA. I am new to VBA so I apologize for my trivial understanding. I have created some VBA code based off of a tutorial from Access Jujitsu on Youtube.
Private Sub Command0_Click()
On Error GoTo SubError
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim SQL As String
Dim rs1 As DAO.Recordset
Dim i As Integer
Dim qtr As String
'Show user work is being performed
DoCmd.Hourglass (True)
'*********************************************
' RETRIEVE DATA
'*********************************************
'SQL statement to retrieve data from database
SQL = "SELECT Obj, Owner, Recom, Goal, Quality of Measure" & _
"FROM Inventory " & _
"WHERE Owner = ASM" &
"ORDER BY Recom "
'Execute query and populate recordset
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
'If no data, don't bother opening Excel, just quit
If rs1.RecordCount = 0 Then
MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
GoTo SubExit
End If
'*********************************************
' BUILD SPREADSHEET
'*********************************************
'Create an instance of Excel and start building a spreadsheet
'Early Binding
Set xlApp = Excel.Application
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open("\Users\Desktop to TemplateACC.xlsx")
Set xlSheet = xlBook.Worksheets(1)
With xlSheet
'Set second page title - pull quarter and year off of first row
'Won't work if you are pulling multiple time periods!
Select Case Nz(rs1!SalesQuarter, "")
Case 1
qtr = "1st"
Case 2
qtr = "2nd"
Case 3
qtr = "3rd"
Case 4
qtr = "4th"
Case Else
qtr = "???"
End Select
.Range("B3").Value = qtr & " Quarter " & Nz(rs1!SalesYear, "????")
'provide initial value to row counter
i = 1
'Loop through recordset and copy data from recordset to sheet
Do While Not rs1.EOF
.Range("I" & i).Value = Nz(rs1!Owner, "")
.Range("J" & i).Value = Nz(rs1!Goal, 0)
.Range("K" & i).Value = Nz(rs1!Recom, 0)
i = i + 1
rs1.MoveNext
Loop
End With
SubExit:
On Error Resume Next
DoCmd.Hourglass False
xlApp.Visible = True
rs1.Close
Set rs1 = Nothing
Exit Sub
SubError:
MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
GoTo SubExit
End Sub
Private Sub Form_Load()
End Sub
My code will not run as it says the "User-defined type is not defined" upon error. I have built this code from a button on a new form, opening the VBA coding template by building the event from the button. I am not sure why the code will not run. It is supposed to export to a pre-existing file called "TemplateACC" but instead this error appears. Thank you for sticking with me on this!
Have you added the Excel object library?
In the VBA editor go to Tools -> References, find Microsoft Excel 1X.0 Object Library and check it.
X depends on the version of Excel installed, but there should only be one, probably 14 to 16.
Binding may be your issue. You can implement early binding by adding the MS Excel Object Library to your References (Tools --> References), or you can implement late binding like below:
Private Sub Command0_Click()
Dim xlApp As object
Dim xlBook As object
Dim xlSheet As object
''If excel is already Running, grab that instance of the program, if not, create new
set xlApp = GetExcel
set xlBook = xlApp.Workbooks.Open("\Users\Desktop to TemplateACC.xlsx")
Set xlSheet = xlBook.Worksheets(1)
''... do other stuff
End sub
Function GetExcel() As Object 'Excel.Application
'Updated: 2009-10-13
'Used to grab the Excel application for automation
If DetectExcel Then
Set GetExcel = GetObject(, "Excel.Application")
Else
Set GetExcel = CreateObject("Excel.Application")
End If
End Function
Function DetectExcel() As Boolean
' Procedure dectects a running Excel and registers it.
Const WM_USER = 1024
Dim hwnd As Long
''If Excel is running this API call returns its handle.
hwnd = FindWindow("XLMAIN", 0)
If hwnd = 0 Then ' 0 means Excel not running.
DetectExcel = False
Exit Function
''Excel is running so use the SendMessage API
''function to enter it in the Running Object Table.
DetectExcel = True
SendMessage hwnd, WM_USER + 18, 0, 0
End If
End Function

Excel VBA - If Else still performing Else

My code is fairly simple but a bit puzzling. I might be committing a minor error - pardon my newbie-ness. The Sheets.Add.Name line still gets executed despite having Boolean = True, thus a new worksheet is created with the Sheet# naming convention.
Sharing my code:
Private Sub create_analyst_btn_Click()
Dim strUser As String
Dim DateToday As String
Dim ws As Worksheet
Dim boolFound As Boolean
strUser = newanalyst_form.user_User.Value
For Each ws In Worksheets
If ws.Name Like strUser Then boolFound = True: Exit For
Next
If boolFound = True Then
MsgBox ("User already exists.")
Else
DateToday = Format(Date, "-yyyy-mm-dd")
Sheets.Add.Name = strUser & DateToday
Unload Me
End If
End Sub
I don't see the point of the first If statement and I would refactor your code to the following:
For Each ws In Worksheets
If ws.Name Like "*" & strUser & "*" Then
MsgBox ("User already exists.")
Exit For
Else
DateToday = Format(Date, "-yyyy-mm-dd")
Sheets.Add.Name = strUser & DateToday
Unload Me
End If
Next ws
The logic here is that if the name already exists before calling the subroutine, we would discover this while iterating, display a warning message in an alert box, and exit. Otherwise, the name/date would be added to the sheet.

Excel VBA - Data connection opens workbook visibly sometimes

When I make a call to open a connection to another workbook, occasionally the workbook will open fully in Excel. I have ~15 data sets I pull using this method and I have not been able to identify a pattern. yesterday the refresh was quick and seamless and no workbooks visibly opened in Excel. Today 1 of 2 is opening in Excel.
Since I have users of varying experience with Excel, I would like to eliminate this possibly confusing behavior.
oCnC.Open "Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Data Source=" & Filename & ";Extended Properties=""Excel 12.0; HDR=YES;"";"
Example code:
sub Caller
Set dTabs = New Dictionary
Set dTabs("Cerner") = New Dictionary
dTabs("Cerner")("Query") = "Select Field1, Field2 from [Sheet1$]"
dTabs("Cerner")("Hidden") = 1
Call GetMasterTables("\\\Files\File1.xlsx", dTabs)
dTabs.RemoveAll
Set dTabs = New Dictionary
Set dTabs("SER") = New Dictionary
dTabs("SER")("Query") = "Select [1],F75 from [Sheet1$]"
dTabs("SER")("Hidden") = 1
Call GetMasterTables("\\Files\File2.xlsx", dTabs)
dTabs.RemoveAll
(Cleanup)
End Sub
Private Sub GetMasterTables(Filename As String, dTabset As Dictionary, ByRef wb As Workbook)
Dim oCnC As Connection
Dim rsC As Recordset
Dim rsE As Recordset
Dim lo As ListObject
Dim rngHome As Range
Set oCnC = New Connection
Set rsC = New Recordset
Set rsE = New Recordset
Dim ws As Worksheet
oCnC.Open "Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Data Source=" & Filename & ";" & _
"Extended Properties=""Excel 12.0; HDR=YES;"";"
rsC.ActiveConnection = oCnC
For Each i In dTabset
If SheetExists(i, wb) Then
Set ws = wb.Sheets(i)
ws.Visible = xlSheetVisible
Else
Set ws = wb.Sheets.Add(, wb.Sheets(wb.Sheets.count))
ws.Name = i
ws.Visible = xlSheetVisible
End If
Set rngHome = ws.Range("A1")
If RangeExists("Table_" & Replace(i, "-", "_"), ws) Then
Set lo = ws.ListObjects("Table_" & Replace(i, "-", "_"))
lo.DataBodyRange.Delete
Else
Set lo = ws.ListObjects.Add(, , , xlYes, rngHome)
lo.Name = "Table_" & Replace(i, "-", "_")
lo.DisplayName = "Table_" & Replace(i, "-", "_")
End If
If dTabset(i).Exists("Query") Then
rsC.Source = dTabset(i)("Query")
Else
rsC.Source = "Select * from [" & i & "$]"
End If
rsC.Open
rsC.MoveFirst
ws.Range(lo.HeaderRowRange.Offset(1, 0).address).Value = "hi"
lo.DataBodyRange.CopyFromRecordset rsC
rsC.MoveFirst
For Each j In lo.HeaderRowRange.Cells
j.Value = rsC.Fields(j.Column - 1).Name
Next j
rsC.Close
If dTabset(i).Exists("Hidden") Then
ws.Visible = xlSheetHidden
Else
ws.Visible = xlSheetVisible
End If
Next i
End Sub
Function SheetExists(ByVal shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
SheetExists = Not sht Is Nothing
End Function
Function RangeExists(ByVal rngName As String, Optional ws As Worksheet) As Boolean
Dim rng As ListObject
If ws Is Nothing Then Set ws = ActiveWorksheet
On Error Resume Next
Set rng = ws.ListObjects(rngName)
On Error GoTo 0
RangeExists = Not rng Is Nothing
End Function
Update 1
Ah-ha! I have an update.
After the last test I had left the workbook open. When I came back to the computer after a few minutes there was a prompt up that the file was available for editing. Perhaps the intermittent behavior is due to the requested file being open by another user. I tested this theory by closing the workbook and then re-running the sub and it did not open the file in the app.
Update 2
Qualified my sheets references. Issue is still happening.
The issue is here (and anywhere else you're using Sheets without an object reference):
Set ws = Sheets(i)
ws.Visible = xlSheetVisible
Sheets is a global collection of the Application, not the Workbook that the code is running from. Track down all of these unqualified references and make them explicit:
Set ws = ThisWorkbook.Sheets(i)
You should also pass your optional parameter here:
'SheetExists(i)
'...should be...
SheetExists(i, ThisWorkbook)
I'm guessing the reason this is intermittent is that you're catching instances where the ADO connection has the other Workbook active, and your references aren't pointing to where they're supposed to.
In addition to the code review offered by #Comintern and #YowE3K I found a solution in the following:
Qualify my workbooks, and my sheets
Turn off screen updating (so the users can't see my magic)
Throw the book names in a dictionary before I do my update and close any extras that opened during the update.
Application.ScreenUpdating = False
For i = 1 To Application.Workbooks.count
Set dBooks(Application.Workbooks(i).Name) = i
Next i
Application.ScreenUpdating = False
Code from question
For i = 1 To Application.Workbooks.count
If dBooks.Exists(Application.Workbooks(i).Name) Then
dBooks.Remove (Application.Workbooks(i).Name)
Else
dBooks(Application.Workbooks(i).Name) = i
End If
Next i
For Each bookname In dBooks
Application.Workbooks(bookname).Close (False)
Next
Application.ScreenUpdating = True

VBA Word macro goes to breakmode

I'm trying to open two documents from excel with vba and call a word macro from this particular excel file.
The macro is working fine in Word and I also get the documents to open and the word macro to start. However when there is a switch from one document to the other the word macro goes to break-mode (which does not happen when I run it from Word instead of Excel).
I use the following code from excel:
Set wordApp = CreateObject("Word.Application")
worddoc = "H:\Word Dummy's\Dummy.docm"
wordApp.Documents.Open worddoc
wordApp.Visible = True
wordApp.Run macroname:="update_dummy", varg1:=client, varg2:=m_ultimo, varg3:=y
In word I have a sub with the parameters defined between breakets and the following code:
worddoc2 = "H:\Word Dummy's\texts.docx"
Word.Application.Activate
Documents.Open worddoc2, ReadOnly:=True
ThisDocument.Activate
Set bmks = ThisDocument.Bookmarks
Can anyone tell me why it does not run from excel and how I can fix this?
Thanks in advance.
I finally found the answer myself after a lot of searching on Google.
I needed to add :
application.EnableEvents=false
To the excel macro.
That was all. Now it works.
My complete code is huge (the macro in excel also opens two other workbooks and runs a macro in them). This part of the code is working for now (so I left it out), but I just want to add the part that it opens a worddoc and adds specific texts in it depending on what client has been chosen in the excel userform. But to show you a better idea how my code looks like, this is in excel (where the client is defined by a userform in another module):
Sub open_models (client as string)
Application.DisplayStatusBar = True
‘determine datatypes
Dim m_integer As Integer
Dim m_ultimo As String
Dim m_primo As String
Dim y As String
Dim y_integer As Integer
Dim y_old As String
Dim y_last As String
Dim wordApp As Object
Dim worddoc As String
'Determine current month and year and previous
m_integer = Format(Now, "mm")
y_integer = Format(Now, "yyyy")
If m_integer <= 9 Then
m_ultimo = "0" & m_integer - 1
m_primo = "0" & m_integer - 2
Else
m_ultimo = m_integer - 1
m_primo = m_integer - 2
End If
If m_integer = 1 Then
y = y_integer - 1
Else
y = y_integer
End If
On Error Resume Next
'open word dummy
Set wordApp = CreateObject("Word.Application")
worddoc = "H:\RAPORTAG\" & y & "\" & y & m_ultimo & "\Dummy.docm"
wordApp.Documents.Open worddoc
wordApp.Visible = True
wordApp.Run macroname:="update_dummy", varg1:=client, varg2:=m_ultimo, varg3:=y, varg4:= worddoc)
On Error GoTo 0
ThisWorkbook.Activate
'reset statusbar and close this workbook
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
ThisWorkbook.Close False
End Sub
 
And this is the code in word I am using:
Sub update_dummy(client As String, m_ultimo As String, y As String, worddoc as string)
Dim wordapp As Object
Dim rngStart As Range
Dim rngEnd As Range
Dim worddoc As String
Dim worddoc2 As String
Dim dekkingsgraad As String
Dim bmks As Bookmarks
Dim bmRange As Range
Dim rng As Range
Dim i As Boolean
On Error Resume Next
worddoc2 = "H:\RAPORTAG\" & y & "\" & y & m_ultimo & "\dummytexts.docx"
'open other word
Documents.Open worddoc2, ReadOnly:=True
Documents(worddoc).Activate
Set bmks = Documents(worddoc).Bookmarks
'management summary
If client <> "PMT" Then
i = True
Set rngStart = Documents(worddoc2).Bookmarks("bn0_1_start").Range
Set rngEnd = Documents(worddoc2).Bookmarks("bn0_1_end").Range
End If
If i = True Then
Set rng = Documents(worddoc2).Range(rngStart.Start, rngEnd.End)
rng.Copy
Set bmRange = Documents(worddoc).Bookmarks("bmManagementsummary").Range
bmRange.PasteAndFormat (wdPasteDefault)
End If
i = False
On Error GoTo 0
End Sub
I have 20 more bookmarks that are defined but the code for them is all the same.
I have seen and solved this problem a few times before, the solution I found was odd.
Copy paste all your code into a text
editor, 1 for word, 1 for excel
Delete all the macros in word or excel or better yet, just create
new files.
Paste all the code into word/excel from your text editor.
I've definitely had this 3 or 4 times in Excel and Access. Especially if you previously had a breakpoint at that location.
It sounds stupid but try it and see if that works, this has saved me from insanity a few times.

Outlook Forms: Importing / VLOOKUP Data from Excel?

I am a bit new to Outlook forms, but not to VBA overall - nor HTML/Web design of forms. However, my problem is finding a way to combine the two.
I am trying to design a form for users to fill out, and based on what they fill out in drop-down box's, it will then tell them what we want them to attach in the email. Currently we have this done in Excel, based on dropbox's it then VLOOKUPS to the 2nd Spreadsheet that contains the forms required.
Is there anyway I can bring in the Excel with the VLOOKUP behind the scenes in my VBA Outlook Form so that it can look-up what attachments we want the user to do? Otherwise, it would be a TON of SELECT CASE statements in VBA =/
This seems to the do the trick for me.
Some of it I have cobbled together from sites like this, the rest has been created by myself from scratch.
When I click my button:
An input box appears, which is the value that will be looked up in the spreadsheet.
it looks in the range (specified in the code), for a match
returns the value, two columns to the left of it.
when it finds a match it puts it in the Subject line in Outlook.
Dim jobno As String
Dim Proj As String
Sub Test()
jobno = InputBox("Job Number?", "Test")
GetNameFromXL
If jobno <> "" Then
Set myItem = Application.CreateItem(0)
If Proj <> "" Then
myItem.Subject = jobno & " - " & Proj & " - " & Format(Date, "dd.mm.yy")
Else
myItem.Subject = jobno & " - " & Format(Date, "dd.mm.yy")
End If
myItem.Display
Else
Exit Sub
End If
End Sub
Sub GetNameFromXL()
'Late binding. No reference to Excel Object required.
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Set xlApp = CreateObject("Excel.Application")
'Open the spreadsheet to get data
Set xlWB = xlApp.Workbooks.Open("X:\...\FILENAME.xlsx") ' <-- Put your file path and name here
Set xlWS = xlWB.Worksheets(1) ' <-- Looks in the 1st Worksheet
Debug.Print "-----Start of 'For Each' loop"
For Each c In xlWS.Range("A6:A100") 'Change range to value you want to 'VLookUp'
Proj = c.Offset(0, 2).Value 'This looks at the 2nd column after the range above
Debug.Print c & Proj
If jobno = c Then
Debug.Print "-----Match Found: " & jobno & " = " & Proj
GoTo lbl_Exit
Else
End If
Next c
Debug.Print "-----End of For Each loop"
MsgBox jobno & " not found in WorkBook."
'Clean up
Set xlWS = Nothing
Set xlWB = Nothing
Set c = Nothing
Proj = ""
xlApp.Quit
Set xlApp = Nothing
lbl_Exit:
Exit Sub
End Sub