I have a set of functions that is meant to read data from various worksheets in a separate workbook. The main routine uses a loop to go through various sheet names and within the function two levels down, it looks into the workbook to grab data. I am getting runtime error '-2147023174' (800706ba) Automation error at various points in this function, and am wondering where the error lies.
Sub mainRoutine()
'opens workbook and runs makeFile function on a loop
Dim wbOBJ As Workbook, oFile As integer
Set wbOBJ = Workbooks.Open(filePath, ReadOnly:=True)
For k = 1 To 20
makeFile myBox.List(k), wbOBJ
Next k
wbOBJ.Saved = True
wbOBJ.Close
End Sub
Function makeFile(ShtName As String, ByRef wbOBJ as Workbook)
'calls various procedures from which to collect data
'and passes workbook object along
debug.print wbOBJ.Sheets(1).Cells(1,1).Value
printInfoA(ShtName)
printInfoB(ShtName, wbOBJ)
End Function
Function printInfoB(ShtName as String, ByRef wbOBJ as Workbook)
'assigns object to a sheet inside the other workbook, collects data
Dim wsOBJ As Worksheet
Set wsOBJ = wbOBJ.Sheets(ShtName)
For j = 1 to 10
Thisworkbook.Sheets(1).Cells(j,1) = wsObj.Cells(j, 1)
Next j
End Function
Even in the makeFile function, the error pops up on the debug.print line, even though the debug.print works, and produces the correct value.
If I suppress that line, the same error will instead occur in the mainRoutine on the wbOBJ.Saved = True line. What is causing these errors?
(Note that I originally tried to organize it this way, instead of having the workbook open and close everytime I ran the printInfoB function, as I am trying to increase speed.)
Related
I wrote 4 macros to do things, but it requires 2 inputs from the user to make sure the right file is being used because some of the macros switch back and between 2 workbooks. I only had access to a few of the files, but I knew that eventually I would have access to the rest of the 35 files. If I didn't have the inputs, I would have to manually change the filename in the macro code, but I don't want to do that, so I used inputs. But now that I have all the files in the right format, I am trying to a separate macro that has a list of the other files in a separate workbook, and then opens those files and does the macros, but it would require the inputs a lot. So now, I'm trying to remove that need for the inputs. But I'm unfamiliar with public variables and somewhat familiar with the calling of other subroutines.
My setup is this:
option explicit
public current as string
Sub master_macro
dim i as integer
dim path as string
dim wb as workbook
dim sht as worksheet
set wb = workbooks("name.xlsx")
set sht = wb.worksheets(1)
path = "C:\xxx\"
wb.activate
for i = 1 to 20
currun = sht.cells(i,1).value 'this takes the value from the separate workbooks that has the file names
full_currun = currun & ".xlsx"
with workbooks.open(path & full_currun)
.activate
call blanks
call lookup
call transfer
call combine
.save
.close
end with
next i
The last 2 macros switch between 2 sheets. So in those macros, the currun is generated the an inputbox, albeit a different name.
nam = inputbox("yadda yadda")
set wb = workbooks(nam & ".xlsx")
I'm trying to get the currun vaue that is defined in the master macro to macro3 and macro4.
You see the part where it says Sub master_macro? What you are doing there is declaring a procedure, which is a basically a general term to describe "a block of self-contained code that does something when it is run." Procedure declarations have three major components:
type - this is what you are doing with Sub; you are saying it is a subroutine, which is distinct from a function Function in that it does not return a value
name - this is the identifier you use to refer to the procedure elsewhere in your code. it is supposed to be descriptive since that enhances the readability. "master_macro" is not bad, but as a general rule you don't want to use underscores when naming procedures in VBA.
parameters - this is where you define the set of variable values that can be passed to the procedure when it is run. each parameter is separated by a comma and declared using the syntax [pass type] + [variable name] + [variable type]. [pass type] is either ByRef or ByVal; the basic distinction is that ByRef sends a direct reference to the variable, while ByVal sends a copy of the value.
The last part is what you are missing to solve this problem. Both macro3 and macro4 are declared (in module B) like master_macro is here. If they need to know what the currun value is then simply add (ByVal currun As String) to their declarations. When they are called from another procedure, as they are in master macro, they will expect to receive a string. Change the two lines in master macro from:
Call macro3
Call macro4
to
Call macro3(full_currun)
Call macro4(full_currun)
and macro3 and macro4 will have the value of full_currun stored in their own internal variable currun for use as they need.
Thanks guys. managed to get it to work. Here's the finished work below
sub master()
dim i as integer
dim path, currun, fullcurrun as string
dim wb as workbook
dim sht as worksheet
set wb = workbooks("Name.xlsx")
set sht = wh.worksheets(1)
path = "C:\xxx\"
wb.activate
for i = 1 to ?
currun = sht.cells(i,1).value
fullcurrun = currun & ".xlsx"
workbooks.open(path & fullcurrun)
call blank(currun)
call lookup(currun)
call transfer(currun)
activeworkbook.save
activeworkbook.close
call transfer(currun)
next i
end sub
public sub blank/lookup/transfer(byval currun as string)
blah blah blah
end sub
In an attempt to retrieve constants from each worksheet in some reporting workbooks I use, three years ago I wrote some code that gets included in each worksheet. Here's an example of the code:
Option Explicit
' Determine the type of worksheet
Private Const shtType As String = "CR"
Public Function GetShtType()
GetShtType = shtType
End Function
In other code that gets the values from the worksheets for processing, the following section of code is used, where 'wksToCheck' is the worksheet in question. This code is stored in a personal macro workbook, not in the workbook with the worksheet code:
' Get the sheet 'type' if it has one
On Error Resume Next
shtType = wksToCheck.GetShtType()
If Err.Number <> 0 Then
' We do not have a type
shtType = "Unknown"
Err.Clear
End If ' Err.Number...
On Error GoTo Error_BuildTemplateWbk
My problem is, I use the code above to process workbooks several times a week, and I have for the past three years. Now, I am trying to write some new code with the above block to process the report workbooks in a different way. However, when I run code with the above block now, I get a 'Method or Data Member Not Found' error on the '.GetShtType()' portion of the code. I cannot compile the code and of course, consequently, the code doesn't work. I have tried adding the worksheet code to a worksheet in the macro workbook to see if that would fix the problem. It hasn't. Does anyone have any ideas? I am running Excel 2013 on a Windows 7 PC. Any ideas?
Brian
Using late-binding, should avoid the error, Dim wksToCheck As Object, but you'll lose the intellisense.
If you're open to alternatives, you may have better luck simply using the CallByName function, or using worksheet's CustomProperties.
Using CallByName preserves backwards compatibility with your older workbooks if needed:
shtType = CallByName(wksToCheck, "GetShtType", VbMethod)
Or, using CustomProperties instead of a custom method, in your worksheets:
Private Sub Worksheet_Activate()
Const PropName$ = "ShtType"
Const ShtType$ = "CR"
On Error Resume Next
Me.CustomProperties(PropName) = ShtType$
If Err.Number = 13 Then
Me.CustomProperties.Add "PropName", ShtType
End If
End Sub
Then,
' Get the sheet 'type' if it has one
On Error Resume Next
shtType = wksToCheck.CustomProperties("ShtType")
If Err.Number = 13 Then
' We do not have a type
shtType = "Unknown"
Err.Clear
End If ' Err.Number...
On Error GoTo Error_BuildTemplateWbk
I try to create a macro, placed in Workbook_Open() procedure, which adds items for combo boxes, named CBTask for each sheet in workbook, (which has combo box named CBTask in it).
Unfortunatelly following code generates Compile error: Method or data member not found"
I believe it is because not every sheet has CBTask in it (even on error resume next does not help).
Is there any way to check if sheet contains combo box, so I could do the checking before trying clear it, or adding new items?
Private Sub Workbook_Open()
Dim ws As Worksheet
Dim i As Integer
Dim strTaskName As String
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
ws.CBTask.Clear
strTaskName = taskName(1)
Do
ws.CBTask.AddItem strTaskName
strTaskName = taskName(i)
i = i + 1
Loop While taskName <> "LastOne"
Next ws
On Error GoTo 0
End Sub
(as you can see, this code also uses additional function "taskName(intSubtaskValue as integer)" to convert integer to string (e.g. taksName(1) = "Task01", taskName(2) = "Task02...)
The Worksheet class doesn't have a member named CBTask which is why that code fails. I suggest you use the OLEObjects property instead:
ws.OLEObjects("CBTask").Object.Clear
To expand on Rory's answer, in addition to fully qualifying your objects, you can check if an ActiveX-control of a given name exists on a worksheet by using this function:
Function obj_exists(obj_name As String, on_worksheet As Worksheet) As Boolean
On Error GoTo errHandler
Debug.Print on_worksheet.OLEObjects(obj_name).Name
obj_exists = True
On Error GoTo 0
Exit Function
errHandler:
obj_exists = False
On Error GoTo 0
End Function
My goal is to implement some of functions where I give them parameters of power, frequency and speed of an electric motor, and look in another workbook (in which I have motor data) and return the size, shaft diameter and other motor details.
As I have not mastered much VBA I tried to implement a function that simply goes to a cell in another workbook and returns the value:
Function Test() As String
Dim name As String
With Workbooks.Open("D:\ExcelTest\WbSource.xlsm").Sheets("Sheet1")
name = .Cells(2, 3)
End With
Test= name
ActiveWorkbook.Save
ActiveWorkbook.Close
End Function
The problem is that it gives me a #VALUE! error, but each variable used is defined as a string and the cells has general format (if I change cells format to text it gives me the same message).
Try as I might, I could not get workbooks.open to work in a function, even if the function calls a sub. You could open the catalogue file in the workbook open event, and close it again in the before close event.
In the VProject Explorer, right click on "ThisWorkBook," and "View code".
In the pick list at the top, select Workbook, and the sub Workbook_open() procedure should be created. If not, select "Open" in the right pick list. Put in the following:
Application.Workbooks.Open ("D:\ExcelTest\WbSource.xlsm")
ThisWorkbook.Activate 'restores the "focus" to your worksheet
Then click the right pick list and select "beforeClose" and put in
On Error Resume Next 'this keeps it from crashing if the catalogue is closed first
Workbooks("WbSource.xlsm").Close
As long as the worksheet opens the wbsource file first, the function will work.
Here is an approach with scheduling UDF execution in queue, and processing outside UDF that allows to get rid of UDF limitations. So the value from the closed workbook got via ExecuteExcel4Macro() by a link.
Put the following code into one of the VBAProject Modules:
Public Queue, QueueingAllowed, UDFRetValue
Function UDF(ParamArray Args())
If IsEmpty(Queue) Then
Set Queue = CreateObject("Scripting.Dictionary")
UDFRetValue = ""
QueueingAllowed = True
End If
If QueueingAllowed Then Queue.Add Application.Caller, (Args)
UDF = UDFRetValue
End Function
Function Process(Args)
If UBound(Args) <> 4 Then
Process = "Wrong args number"
Else
' Args(0) - path to the workbook
' Args(1) - filename
' Args(2) - sheetname
' Args(3) - row
' Args(4) - column
On Error Resume Next
Process = ExecuteExcel4Macro("'" & Args(0) & "[" & Args(1) & "]" & Args(2) & "'!R" & Args(3) & "C" & Args(4))
End If
End Function
Put the following code into ThisWorkbook section of VBAProject Excel Objects:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim Item, TempFormula
If Not IsEmpty(Queue) Then
Application.EnableEvents = False
QueueingAllowed = False
For Each Item In Queue
TempFormula = Item.FormulaR1C1
UDFRetValue = Process(Queue(Item))
Item.FormulaR1C1 = TempFormula
Queue.Remove Item
Next
Application.EnableEvents = True
UDFRetValue = ""
QueueingAllowed = True
End If
End Sub
After that you can get the values from closed workbook via worksheet formula using UDF:
=UDF("D:\ExcelTest\";"WbSource.xlsm";"Sheet1";2;3)
Anyway you can add Workbooks.Open() or any other stuff into Function Process(Args) to make it to work the way you want. The code above is just an example.
I've answered the similar questions here and here, so that descriptions might be helpful.
I suggest:
open WbSource.xlsm either manually or via VBA outside the UDF.
pass the parameters to the UDF
have the UDF search down the columns of the newly opened workbook to find the correct record
have the UDF pass the row number back to the worksheet
in the worksheet, use Match()/Index() formulas to retrieve other data.
I am writing a reporting tool to document Excel files for various "compliance criteria", including wkb.VBProject.Protection to report if the VBA is locked.
But how can I find if the workbook HAS any project ?
If I calculate
wkb.VBProject.VBComponents.Count - wkb.Worksheets.Count - 1 '(for the workbook)
that will give me the number of modules + class modules + forms, but I could still have some code behind a sheet.
Is there a way in Excel - like Access frm.HasModule - to find out if there's any VBA code in the workbook ?
Excel 2007+ has a new workbook property called ".HasVBProject" that you can enquire.
For Excel 2003 and earlier the above solution testing for lines of code in the CodeModule of any of the VBComponents of the workbook is appropriate.
You should test the ".CountOfLines" property all alone, since lines of code in the Declaration section of a code module (obtained via ".CountOfDeclarationLines") are considered by Excel as "Macro code" and require saving to macro-enabled formats.
Public Function HasVBProject(Optional pWorkbook As Workbook) As Boolean
'
' Checks if the workbook contains a VBProject.
'
On Error Resume Next
Dim wWorkbook As Workbook
Dim wVBComponent As VBIDE.VBComponent ' As Object if used with Late Binding
' Default.
'
HasVBProject = False
' Use a specific workbook if specified, otherwise use current.
'
If pWorkbook Is Nothing _
Then Set wWorkbook = ActiveWorkbook _
Else Set wWorkbook = pWorkbook
If wWorkbook Is Nothing Then GoTo EndFunction
If (VBA.CInt(Application.Version) >= 12) _
Then
' The next method only works for Excel 2007+
'
HasVBProject = wWorkbook.HasVBProject
Else
' Signs the workbook has a VBProject is code in any of the VBComponents that make up this workbook.
'
For Each wVBComponent In wWorkbook.VBProject.VBComponents
If (wVBComponent.CodeModule.CountOfLines > 0) _
Then
' Found a sign of programmer's activity. Mark and quit.
'
HasVBProject = True: Exit For
End If
Next wVBComponent
End If
EndFunction:
Set wVBComponent = Nothing
Set wWorkbook = Nothing
End Function
Dutch
I've used the following to count the total number of lines in a project before. It will pick up code in ThisWorkbook, code modules, class modules and forms.
Private Sub countCodeLines()
Dim obj As Object
Dim VBALineCount As Long
For Each obj In ThisWorkbook.VBProject.VBComponents
VBALineCount = VBALineCount + obj.CodeModule.CountOfLines
Next obj
Debug.Print VBALineCount
End Sub
Note however that if your workbooks have Option Explicit forced then this will count as two lines per object (Option Explicit and a line feed). If you know this to be the case, and are checking the LOC from another project, then you could simply count the number of objects, double it and test that VBALineCount does not exceed this number.
After Lunatik's hint, here's my final function (for whom it may help):
Function fTest4Code(wkb As Workbook) As Boolean
'returns true if wkb contains VBA code, false otherwise
Dim obj As Object
Dim iCount As Integer
For Each obj In wkb.VBProject.VBComponents
With obj.CodeModule
'# lines - # declaration lines > 2 means we do have code
iCount = iCount + ((.CountOfLines - .CountOfDeclarationLines) > 2)
End With
If iCount 0 Then Exit For 'stop when 1st found
Next obj
fTest4Code = CBool(iCount)
End Function