Excel VBA Run-time error 438 first time through code - vba

I'm a novice self-taught VBA programmer knowing just enough augment Excel/Access files here and there. I have a mysterious 438 error that only popped up when a coworker made a copy of my workbook (Excel 2013 .xlsm) and e-mailed it to someone.
When the file is opened, I get a run time 438 error when setting a variable in a module to a ActiveX combobox on a sheet. If I hit end and rerun the Sub, it works without issue.
Module1:
Option Private Module
Option Explicit
Public EventsDisabled As Boolean
Public ListBox1Index As Integer
Public cMyListBox As MSForms.ListBox
Public cMyComboBox As MSForms.Combobox
Public WB As String
Sub InitVariables()
Stop '//for breaking the code on Excel open.
WB = ActiveWorkbook.Name
Set cMyListBox = Workbooks(WB).Worksheets("Equipment").Listbox1
Set cMyComboBox = Workbooks(WB).Worksheets("Equipment").Combobox1 '//438 here
End Sub
Sub PopulateListBox() '//Fills list box with data from data sheet + 1 blank
Dim y As Integer
If WB = "" Then InitVariables
ListBox1Index = cMyListBox.ListBoxIndex
With Workbooks(WB).Worksheets("Equipment-Data")
y = 3
Do While .Cells(y, 1).Value <> ""
y = y + 1
Loop
End With
Call DisableEvents
cMyListBox.ListFillRange = "'Equipment-Data'!A3:A" & y
cMyListBox.ListIndex = ListBox1Index
cMyListBox.Height = 549.75
Call EnableEvents
End Sub
...
PopulateListBox is called in the Worksheet_activate sub of the "Equipment" sheet.
All my code was in the "Equipment" sheet until I read that was bad form and moved it to Module1. That broke all my listbox and combobox code but based on the answer in this post I created the InitVariables Sub and got it working.
I initially called InitVariables once from Workbook_open but added the If WB="" check after WB lost its value once clicking around different workbooks that were open at the same time. I'm sure this stems from improper use of Private/Public/Global variables (I've tried understanding this with limited success) but I don't think this is related to the 438 error.
On startup (opening Excel file from Windows Explorer with no instances of Excel running), if I add a watch to cMyComboBox after the code breaks at "Stop" and then step through (F8), it sets cMyComboBox properly without error. Context of the watch does not seem to affect whether or not it prevents the error. If I just start stepping or comment out the Stop line then I get the 438 when it goes to set cMyComboBox.
If I add "On Error Resume Next" to the InitVariables then I don't error and the project "works" because InitVariables ends up getting called again before the cMyComboBox variable is needed and the sub always seems to work fine the second time. I'd rather avoid yet-another-hack in my code if I can.
Matt

Instead of On Error Resume Next, implement an actual handler - here this would be a "retry loop"; we prevent an infinite loop by capping the number of attempts:
Sub InitVariables()
Dim attempts As Long
On Error GoTo ErrHandler
DoEvents ' give Excel a shot at finishing whatever it's doing
Set cMyListBox = ActiveWorkbook.Worksheets("Equipment").Listbox1
Set cMyComboBox = ActiveWorkbook.Worksheets("Equipment").Combobox1
On Error GoTo 0
Exit Sub
ErrHandler:
If Err.Number = 438 And attempts < 10 Then
DoEvents
attempts = attempts + 1
Resume 'try the assignment again
Else
Err.Raise Err.Number 'otherwise rethrow the error
End If
End Sub
Resume resumes execution on the exact same instruction that caused the error.
Notice the DoEvents calls; this makes Excel resume doing whatever it was doing, e.g. loading ActiveX controls; it's possible the DoEvents alone fixes the problem and that the whole retry loop becomes moot, too... but better safe than sorry.
That said, I'd seriously consider another design that doesn't rely so heavily on what appears to be global variables and state.

Related

Excel VBA Application.StatusBar in Worksheet_Deactivate fails with 50290

I have a Worksheet, which updates the StatusBar based on which cell is selected (this works fine). My problem is, with the code that sets the StatusBar back to empty when the user goes to another Worksheet:
Private Sub Worksheet_Deactivate()
Application.StatusBar = vbNullString ' Run time error here
End Sub
Err.Description is: "Method 'StatusBar' of object '_Application' failed", Err.Number is: 50290.
This error occurs only if the user changes from Worksheet to Worksheet rapidly (by pressing Ctrl+PgUp or Ctrl+PgDown) and does not happen in case of switching to another Sheet slowly.
Why do I have this error?
Just set it to False
Application.StatusBar = False
from Microsoft:
This property returns False if Microsoft Excel has control of the status bar. To restore the default status bar text, set the property to False; this works even if the status bar is hidden.
I found the problem. When an event handler starts execution, the Excel Application may not be ready, so this has to be checked if the code refers to objects related to the Application:
Private Sub Worksheet_Activate()
If Application.Ready = False Then Exit Sub
' Rest of the code referring to Application.x or Me.y or ActiveSheet.z, etc.
End Sub

Determining if a cell is linked to a QueryTable via VBA in Excel

I'm linking an Excel worksheet to a data source using QueryTables which works well. I'd like to introduce logic to check a given cell and determine if that cell is the top left corner of an existing QueryTable. This seemed trivial in concept, but has proven elusive in practice. If I try to check any properties of the cell that relate to QueryTable I get an error. i.e. rng.querytable throws error 1004 if rng does not link to a QueryTable. So I messed around with testing if rng.ListObject is nothing based on some discussions I found online. It turns out that rng.ListObject is something if the cell is a table even if that table is not a QueryTable. So no dice there.
So how do I test if a target cell contains a QueryTable?
Here's a stub of my function I got from Mr. Excel:
Public Function IsRangeInQueryTable(rngCheck As Range) As Boolean
Dim QT As QueryTable
For Each QT In rngCheck.Parent.QueryTables
If Not Intersect(rngCheck, QT.ResultRange) Is Nothing Then
IsRangeInQueryTable = True
Exit Function
End If
Next QT
'If it got to here then the specified range does not lie
'in the result range of any query
IsRangeInQueryTable = False
End Function
The function above works in many cases, but if I have QueryTables that have become detached from their destination (which seems to happen in practice) the code throws error 1004 because the QueryTable has no destination. Here's what the watch shows when the QueryTable becomes decoupled from a destination:
FWIW, I also tried approaching this the reverse way and iterating through every QueryTable in a worksheet. It turns out if there's a QueryTable which has had its destination deleted, asking that QueryTable for its QueryTable.Destination throws an app error. So I could not figure out a reliable way to do that approach either.
This is wordier than it needs to be, but because the "OnError" statement redirects all errors, I want to eliminate the possibility of accidentally handling the wrong error, for example if rng was Nothing.
Public Function cell_has_query(rng As Range) As Boolean
If rng Is Nothing Then
cell_has_query = False
Exit Function
End If
If rng.ListObject Is Nothing Then
cell_has_query = False
Exit Function
End If
On Error GoTo ErrHandler
If Not rng.ListObject.QueryTable Is Nothing Then
cell_has_query = True
End If
Exit Function
ErrHandler:
If Err.Number = 1004 Then 'Application-Defined or Object-Defined Error
cell_has_query = False
Else
On Error GoTo 0
Resume
End If
End Function
#JDLong VBA error handling is odd. The default setting for errors is On Error GoTo 0, which means that (depending upon your VBA IDE settings; Tools-->Options-->General) will pop up a message box for unhandled errors. If you want to explicitly catch and handle errors, you create a label (e.g. "ErrHandler") and then make sure that section of code is unreachable normally by ending the function with Exit Function. In the block of code after the label, you can inspect the Err object properties and choose to Resume to retry the line of code that caused the error, Resume Next to run the line following the one that errored, or simply handle the error and let the function exit normally. You can also reraise the error by setting the mode back to On Error GoTo 0 and then Resumeing the line.
for some reason that is not clear to me, my querytables are not in listobjects. I thought all querytables are in listobjects, but I've run enough tests to demonstrate to myself that mine are not. So I slightly edited #blackhawk's function to this:
Public Function cell_has_query(rng As Range) As Boolean
If rng Is Nothing Then
cell_has_query = False
Exit Function
End If
On Error GoTo ErrHandler
If Not rng.QueryTable Is Nothing Then
cell_has_query = True
End If
Exit Function
ErrHandler:
If Err.Number = 1004 Then 'Application-Defined or Object-Defined Error - this throws if there is a querytable with no destination
cell_has_query = False
Else
On Error GoTo 0
Resume
End If
End Function

Excel VBA Retrieve Constant from Worksheet Code Fails When New Code is Written

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

VBA: Two methods of seeing if a file is open

I've got two methods which I feel should tell if a file is open or not.
Method 1 (Error: Subscript out of range):
If Not Workbooks(filename) Is Nothing Then
Workbooks.Open (filename)
End If
Method 2:
If Not IsWorkbookOpen(filename) Then
Workbooks.Open (filename)
End If
Where IsWorkbookOpen() is:
Private Function IsWorkbookOpen(wbname) As Boolean
Dim wBook As Workbook
Set wBook = Nothing
On Error Resume Next
Set wBook = Workbooks(wbname)
If wBook Is Nothing Then
IsWorkbookOpen = False
Else: IsWorkbookOpen = True
End If
End Function
Aside from On Error Resume Next, Method 1 appears to be nearly the same as Method 2.
Could anyone please explain why Method 1 gives the error it does?
Thank you.
They both give a subscript out of range error. But in Method 2 you suppress that error with On Error Resume Next.
Sub SeeError()
On Error Resume Next
Debug.Print Workbooks("DoesNotExist").Name
Debug.Print Err.Description
End Sub
This prints "Subscript Out of Range" in the Immediate Window. The On Error statement doesn't stop the error from occurring, it just handles it. Method 1 doesn't handle errors so the default error handling (stop execution and report the error) is in effect.
VBA tries to evaluate all the parts before it evaluates the conditional statement. So if I have a variable myvar = "xyz" and try to run the following lines...
If IsNumeric(myvar) And Round(myvar, 1) = 3 Then
'you will get an error before the IF is evaluated
End If
it will not work. VBA will evaluate IsNumeric(myvar) fine, then try to evaluate Round(myvar, 1) = 3 and get an error before it checks the entire conditional. So VBA will let you know about the error before it performs the AND operator. If VBA had short circuit evaluation, it would work fine since the first part would evaluate to false.
But the following will work
If IsNumeric(myvar) Then
If Round(myvar, 1) = 3 Then
'second IF statement is not touched since first IF statement evaluates to false
End If
End If
This works because IsNumeric(myvar) evaluates to false and therefore skips the nested statement.
So the error it throws on the Workbooks(filename) will just give the error unless you tell it to resume next. So the method I use is
On Error Resume Next
Set wb = Workbooks(file)
If wb Is Nothing Then
Set wb = Application.Workbooks.Open(dir & "\" & file, ReadOnly:=True)
End If
On Error GoTo 0
Edited to give more detail and correctly capture that the second example will not be evaluated as well as provide a useful solution for the question at hand.
Workbooks(filename) tries to get the element with the identifier (or 'index') filename from the collection Workbooks. If the collection does not contain such an element, you'll get the "Subscript out of range" error. (So in a nutshell: This code will fail whenever the file is not open. You probably don't want this.)
However, the knowledge that such an access will fail if the file is not open, i.e. an error is raised, is being made use of in the second method. The code tries to get the element with the identifier filename from the Workbooks collection and to assign it to the variable wBook. If it fails, the value of the variable wBook will stay Nothing. If it succeeds, the variable wBook will contain a reference to the respective Workbook object.

Bypass Old Hyperlink Error

I have the following issue:
I have a macro script for excel which is running through more then 300 excel workbooks,with several sheets.
The problem is that some of this sheets have faulty hyperlinks and each time I run the macro,the pop-up message informing me that the hyperlink found in the sheet is not working and I have to click each time , : ,,cancel'' . Is there a way (code) that I can write that will automatically ,,cancel'' the pop up question ,if it appears?
You should be able to bypass this by wrapping your code in:
Application.DisplayAlerts = False
-- your code --
Application.DisplayAlerts = True
Maybe the privacy options are related?
http://office.microsoft.com/en-001/excel-help/enable-or-disable-security-alerts-about-links-to-and-files-from-suspicious-web-sites-HA010039898.aspx
Let's say your hyperlinks were pointing to a worksheet's cells, and that worksheet may no longer exist, the best thing to do may be to simply remove those hyperlinks.
This is how you'd do this :
Sub RemoveDeadHyperlinks()
For Each hyperL In ActiveSheet.Hyperlinks
'Extract name of the sheet from the subaddress
toSheet = Left(hyperL.SubAddress, InStr(hyperL.SubAddress, "!") - 1)
If WorksheetExists(toSheet) Then
'Most likely a valid hyperlink!
Else
'Most likely a dead one!
hyperL.Delete
End If
Next
End Sub
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function