I have this code:
Dim wsFunc As WorksheetFunction: Set wsFunc = Application.WorksheetFunction
Dim ws As Worksheet: Set ws = Sheets("2012")
Dim rngLook As Range: Set rngLook = ws.Range("A:M")
'within a loop
currName = "Example"
cellNum = wsFunc.VLookup(currName, rngLook, 13, False)
VLookup is not expected to always find a result; but when it does not find a result the line errors out before I can even error check it the next line.
The error:
Run-time error '1004': Unable to get the VLookup property of the WorksheetFunction class
It works fine when a result is found. What's a good way to handle errors here?
Instead of WorksheetFunction.Vlookup, you can use Application.Vlookup. If you set a Variant equal to this it returns Error 2042 if no match is found. You can then test the variant - cellNum in this case - with IsError:
Sub test()
Dim ws As Worksheet: Set ws = Sheets("2012")
Dim rngLook As Range: Set rngLook = ws.Range("A:M")
Dim currName As String
Dim cellNum As Variant
'within a loop
currName = "Example"
cellNum = Application.VLookup(currName, rngLook, 13, False)
If IsError(cellNum) Then
MsgBox "no match"
Else
MsgBox cellNum
End If
End Sub
The Application versions of the VLOOKUP and MATCH functions allow you to test for errors without raising the error. If you use the WorksheetFunction version, you need convoluted error handling that re-routes your code to an error handler, returns to the next statement to evaluate, etc. With the Application functions, you can avoid that mess.
The above could be further simplified using the IIF function. This method is not always appropriate (e.g., if you have to do more/different procedure based on the If/Then) but in the case of this where you are simply trying to determinie what prompt to display in the MsgBox, it should work:
cellNum = Application.VLookup(currName, rngLook, 13, False)
MsgBox IIF(IsError(cellNum),"no match", cellNum)
Consider those methods instead of On Error ... statements. They are both easier to read and maintain -- few things are more confusing than trying to follow a bunch of GoTo and Resume statements.
There is a way to skip the errors inside the code and go on with the loop anyway, hope it helps:
Sub new1()
Dim wsFunc As WorksheetFunction: Set wsFunc = Application.WorksheetFunction
Dim ws As Worksheet: Set ws = Sheets(1)
Dim rngLook As Range: Set rngLook = ws.Range("A:M")
currName = "Example"
On Error Resume Next ''if error, the code will go on anyway
cellNum = wsFunc.VLookup(currName, rngLook, 13, 0)
If Err.Number <> 0 Then
''error appeared
MsgBox "currName not found" ''optional, no need to do anything
End If
On Error GoTo 0 ''no error, coming back to default conditions
End Sub
From my limited experience, this happens for two main reasons:
The lookup_value (arg1) is not present in the table_array (arg2)
The simple solution here is to use an error handler ending with Resume Next
The formats of arg1 and arg2 are not interpreted correctly
If your lookup_value is a variable you can enclose it with TRIM()
cellNum = wsFunc.VLookup(TRIM(currName), rngLook, 13, False)
Related
I have password-protected .xls files in a directory. I would like to open each of these files and save them without the password.
However, the files can be opened by using either of the sample passwords listed below.
pwd1 = "123"
pwd2 = "456"
pwd3 = "789"
'Check if pwd1 opens
Application.Workbooks.Open(Filename:=fn, Password:=pwd1)
'If fail then use pwd2
Application.Workbooks.Open(Filename:=fn, Password:=pwd2)
'and so on..
How should I implement this?
Once the file has been opened once, you only need to Unprotect it. This will save a lot of time, instead of constantly opening/closing workbooks.
Here's how I'd do it:
Public Sub CrackWorkbook()
Dim fn As String
fn = "C:\Temp\test_password_is_456.xlsx"
Dim wb As Workbook
Set wb = Workbooks.Open(fn)
Dim lst As Variant
lst = Array("123", "456", "789")
Dim item As Variant
For Each item In lst
On Error GoTo did_not_work
Call wb.Unprotect(item)
Call wb.Save
Call wb.Close(False)
Exit Sub
did_not_work:
On Error GoTo 0
Next item
End Sub
In other words, create an array of strings and do a For Each on them, and set some error-handling to deal with all the failed attempts.
I know GoTo statements are a bit yucky, but that's the best way to handle errors in VBA (as far as I know).
I tried #lebelinoz answer however the routine gives a 1004 error. I googled this behavior and found this post:
https://stackoverflow.com/questions/21176638/vba-how-to-force-ignore-continue-past-1004-error
The code below works by using On Error Resume Next. I based this on #lebelinoz answer.
Public Sub CrackWorkbook()
Dim fn As String
fn = "C:\Temp\test_password_is_456.xlsx"
Dim wb As Workbook
Dim item As Variant
Dim lst As Variant
lst = Array("123", "456", "789")
For Each item In lst
On Error Resume Next
Workbooks.Open Filename:=fn, Password:=item
If Err.Number <> 0 Then GoTo did_not_work:
Exit For
did_not_work:
Next item
Set wb = Activeworkbook
wb.SaveAs Filename:=fn, Password:=""
wb.Close
End Sub
I am facing a very weird problem with VBA code. I have an excel file which uses UDFs from an Addin. This file runs on the server so it is really impossible for me to see what actually is going on in the code. Now, whenever I make any changes in the file (on my local machine), I use the local version of the addin. So when replacing the file on the server, I need it to automatically change the links to the addin copy that is there on the server. For this purpose, I have this piece of code in the file:
Private Sub changeLinks(addinName As String, wb As Workbook)
Dim check As Long
Dim i As Long
Dim existingPath As String
Dim correctPath As String
Dim temp As Variant
Dim tempA As Variant
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.ScreenUpdating = False
temp = getLinks(addinName, wb)
On Error Resume Next
correctPath = Application.AddIns(addinName).fullName
For i = 1 To 100
If temp(i) = "" Then Exit For
If UCase(temp(i)) <> UCase(correctPath) Then
wb.ChangeLink temp(i), correctPath, xlLinkTypeExcelLinks
End If
Next
On Error GoTo 0
End Sub
Private Function getLinks(addinName As String, wb As Workbook)
Dim allLinks As Variant
Dim check As Long
Dim i As Long
Dim temp(1 To 100) As Variant
Dim linkCounts As Long
check = 0
allLinks = wb.LinkSources
linkCounts = 0
On Error Resume Next
For i = LBound(allLinks) To UBound(allLinks)
check = InStr(1, UCase(allLinks(i)), UCase(addinName))
If check <> 0 Then
linkCounts = linkCounts + 1
temp(linkCounts) = allLinks(i)
End If
Next
On Error GoTo 0
getLinks = temp
End Function
In spite of all the statements like Application.DisplayAlerts=False and On Error Resume Next, the code hangs on the line where I use .ChangeLink method. Curiously, the code works ok if I login to the server and run this manually. I believe it is due to some pop-up which appears when the code tries to run .ChangeLink statement. I can't see what this pop-up is, because it runs on the server with a different login. And so now I'm just banging my head to the wall.
Appreciate any help.
I'm trying to call a function from a 3rd party Excel-add in a VBA-sub. The function loads data from a database into specified cells in the Excel workbook.The function I'm calling is huge and unfortunaly I can't post it in its entirety, but here are the first two lines:
Public Function loadFromDatabase(ByVal XLname As String, ByVal sMark As String)
Dim xlWB As Workbook
Then it declares a bunch of variables before running the following tests:
'
' Get the excel book and check if it is run in compatibility mode
'
Set xlWB = getXLBook(XLname)
If xlWB Is Nothing Then
loadFromDatabase = "Workbook '" + XLname + "' not found!"
Exit Function
End If
bExcel8Limits = True
If isExcel2007orLater Then
bExcel8Limits = bCheckCompMode(xlWB)
End If
Here I get this message: "Workbook " not found!" http://imgur.com/HQFAzoC .
The getXLBook function looks like this:
'
' Routine to get a specified Workbook
'
Function getXLBook(sName As String) As Workbook
Dim xlWB As Workbook
On Error Resume Next
Set xlWB = Nothing
Set xlWB = Application.Workbooks(sName)
On Error GoTo 0
Set getXLBook = xlWB
End Function
A hint here may be that I'm able to call the function from a Private Sub place in a worksheet like this...
Private Sub loadFromDB()
Dim res As Variant
res = Application.Run("loadFromDatabase", Me.Parent.Name, "")
If res <> "OK" Then
MsgBox res
End If
End Sub
...but not from a module in the same workbook like this
Sub loadFromDB_test()
Dim res As Variant
res = Application.Run("loadFromDatabase", XLname, sMark)
If res <> "OK" Then
MsgBox res
End If
End Sub
Any suggestions?
Edit: To clarify, it's when running loadFromDB_test the "Workbook not found" message pops up.
Edit 2: An obvious hotfix (that I didnt think of) is to just call the Private Sub in the worksheet from the Sub in the module.
Sub load_test_new()
Application.Run "Sheet1.loadFromDB"
End Sub
From a learning point of view this is clearly not a good solution as it is inefficient coding.
Based on the msgbox you display, you're passing an empty string to the function getXLBook. (within the scope of getXLBook this value is stored as sName, but the cause of the error is before you call this function).
So, somewhere in your code, before this:
Set xlWB = getXLBook(XLname)
You should have a line like this, where the right side of the statement assigns a string representing a full, valid filepath:
XLName = "C:\filename.xlsx"
I suspect that your code does not contain this assignment statement, so that should explain the error.
For example, the following function is used for checking whether a workbook is open:
Function BookOpen(Bk As String) As Boolean
Dim T As Excel.Workbook
Err.Clear
On Error Resume Next
Set T = Application.Workbooks(Bk)
BookOpen = Not T Is Nothing
Err.Clear
On Error GoTo 0
End Function
Are these two Err.Clear statements necessary?
In this example
Function BookOpen(Bk As String) As Boolean
Dim T As Excel.Workbook
Err.Clear
On Error Resume Next
Set T = Application.Workbooks(Bk)
BookOpen = Not T Is Nothing
Err.Clear
On Error GoTo 0
End Function
none of the uses is appropriate, because On Error resets the last error, so Err.Clear is redundant.
It's appropriate after actually handling a failed statement.
Function BookOpen(Bk As String) As Boolean
Dim T As Excel.Workbook
On Error Resume Next
Set T = Application.Workbooks(Bk) ' this can fail...
' so handle a possible failure
If Err.Number <> 0 Then
MsgBox "The workbook named """ & Bk & """ does not exist."
Err.Clear
End If
BookOpen = Not T Is Nothing
End Function
If you have On Error Resume Next in effect, the program will continue after an error as if nothing had happened. There is no exception thrown, there is no warning, this is not structured error handling (i.e. it's nothing like try/catch blocks). Your program might end up in a very weird state if you don't do rigorous error checks.
This means you must check errors after. every. statement. that. can. fail. Be prepared to write a lot of If Err.Number <> 0 Then checks. Note that this is harder to get right than it seems.
Better is: Avoid long sections of code that have On Error Resume Next in effect like the plague. Break up operations into smaller functions/subs that do only one thing instead of writing a big function that does it all but can fail halfway through.
In short: Err.Clear makes your program behave predictably after a failed statement in an On Error Resume Next block. It marks the error as handled. That's its purpose.
Of course in your sample it's easy to avoid error handling by using the commonly accepted way of checking whether a workbook (i.e. member of a collection) exists.
Function BookOpen(Bk As String) As Boolean
Dim wb As Variant
BookOpen = False ' not really necessary, VB inits Booleans to False anyway
For Each wb In Application.Workbooks
If LCase(wb.Name) = LCase(Bk) Then
BookOpen = True
Exit For
End If
Next
End Function
VBA6 code (Excel) worked great. Upgrade to Office 2010/VBA7, code breaks.
Using code from SO:
Determining whether an object is a member of a collection in VBA
Public Function Contains(col As Collection, key As Variant) As Boolean
Dim obj As Variant
On Error GoTo err
Contains = True
obj = col(key)
Exit Function
err:
Contains = False
End Function
I get run-time error 5: Invalid procedure call or argument.
It doesn't make sense to me though because the error occurs on the obj = col(key) line which should be covered by the On Error GoTo err statement, but it stops.
Other If X exists in collection type solutions have the same problem.
Instead of fixing the broken code, what I really need is to be able to see if a record is already set for a collection, if that can be done some other (new) way in VBA7, that would solve the problem as well (I can dream).
I find that if I change specify an object, e.g., a worsheet, it works:
Public Function Contains(col As Collection, key As Variant) As Boolean
Dim ws As Excel.Worksheet
On Error GoTo err
Contains = True
Set ws = col(key)
Exit Function
err:
Contains = False
End Function
I call it like this:
Sub test()
Dim ws As Excel.Worksheet
Dim coll As Collection
Set coll = New Collection
For Each ws In ThisWorkbook.Worksheets
coll.Add ws, ws.Name
Next ws
Debug.Print Contains(coll, ActiveSheet.Name)
Debug.Print Contains(coll, "not a worksheet name")
End Sub
I get True for the first call and False for the second.