Using INDEX MATCH in VBA with Variable Lookup Locations - excel

I am having trouble using variables within the lookup criteria in Index Match. Some background: I use the following code to set a variable's value to the row # of whatever cell contains "Current" within column B:
Dim rowHeaderNum As Integer
rowHeaderNum = 0
On Error Resume Next
rowHeaderNum = Application.Match("Current", ActiveSheet.Range("B:B"), 0)
On Error GoTo 0
Then I use the below to store the column # of the cell within the row 'rowHeaderNum' that contains the value "CurrentActual" to another variable:
Dim currActColNum As Integer
currActColNum = 0
currActColNum = Application.Match("CurrentActual", Rows(rowHeaderNum & ":" & rowHeaderNum), 0)
Below is the Index Match line that I can't get to work:
Dim currActRev As Double
currActRev = Application.Index(Columns(currActColNum), Application.Match("Gross Operating Profit", Columns("N:N"), 0))
currActRev will store a dollar amount. The Match function will always use column N as the lookup array. When I run the Index Match line I get a
type mismatch
error in the debugger.

Using WorksheetFunction …
Application.Match and On Error Resume Next does not work, because Application.Match does not throw exceptions you need to use WorksheetFunction.Match instead.
According to the documentation the WorksheetFunction.Match method it returns a Double so you need to Dim RowHeaderNum As Double.
Dim RowHeaderNum As Double
'RowHeaderNum = 0 'not needed it is always 0 after dim
On Error Resume Next
RowHeaderNum = Application.WorksheetFunction.Match("Current", ActiveSheet.Range("B:B"), False)
On Error GoTo 0
Furthermore you need to check if RowHeaderNum is 0 and stop proceeding otherwise the following code will fail because row 0 does not exist.
If RowHeaderNum = 0 Then
MsgBox "'Current' not found."
Exit Sub
End If
You need to do exactly the same here
Dim CurrActColNum As Double
On Error Resume Next
CurrActColNum = Application.WorksheetFunction.Match("CurrentActual", Rows(RowHeaderNum), False)
On Error GoTo 0
If CurrActColNum = 0 Then
MsgBox "'CurrentActual' not found."
Exit Sub
End If
Finally the WorksheetFunction.Index method returns a Variant not a Double and you need error handling here too.
Dim currActRev As Variant
On Error Resume Next
currActRev = Application.WorksheetFunction.Index(Columns(CurrActColNum), Application.WorksheetFunction.Match("Gross Operating Profit", Columns("N:N"), False))
On Error GoTo 0
Debug.Print currActRev 'print result in immediate window
Using Application …
Note that you can also use the Application.Match and Application.Index (without WorksheetFunction) but then you cannot use On Error … and you have to check for errors using IsError(). Also your variables need to be declared as Variant then because Application.Match can either return a typo Double or a type Error.
Dim RowHeaderNum As Variant
RowHeaderNum = Application.Match("Current", ActiveSheet.Range("B:B"), False)
If IsError(RowHeaderNum) Then
MsgBox "'Current' not found."
Exit Sub
End If
Dim CurrActColNum As Variant
CurrActColNum = Application.Match("CurrentActual", Rows(RowHeaderNum), False)
If IsError(CurrActColNum) Then
MsgBox "'CurrentActual' not found."
Exit Sub
End If
Dim currActRev As Variant, currMatch As Variant
currMatch = Application.Match("Gross Operating Profit", Columns("N:N"), False)
If Not IsError(currMatch) Then
currActRev = Application.Index(Columns(CurrActColNum), currMatch)
End If
Debug.Print currActRev 'print result in immediate window

Related

is there away how to handle error 13 in vba

Hello
I have an error 13 on my vlookup all the time ,when I execute vlookup on my sheet it works soon vba doesn't I am looking for help
here is my code , all the columns are Text in my sheet
Sub address_change()
Dim updatesheet As Variant
Dim sbw As String
Dim Param As String
Dim entier As Integer
Dim fname As String
Dim tsk As Task
Dim rg As Variant
Dim ws As Sheets
Dim wb As Excel.Workbook
Dim appXLS As Object
Dim entxls As Object
Dim i As Integer
Set appXLS = CreateObject("Excel.Application")
If appXLS Is Nothing Then
MsgBox ("XLS not installed")
End If
fname = ActiveProject.Path & "\" & Dir(ActiveProject.Path & "\addresses.xlsx")
MsgBox (fname)Set wb = appXLS.Workbooks.Open(fname, False)
Set rg = appXLS.Worksheets("sheet2").Range("A:U")
appXLS.Visible = TrueMsgBox (appXLS.Application.Value)
On Error Resume Next
For Each tsk In ActiveProject.Tasks
Param = tsk.Text2
If tsk.OutlineLevel = 2 Then
updatesheet = appXLS.Application.VLookup(Param, rg, 16, False)
If Err.Number <> 0 Then
tsk.Text13 = "No match 32"
Else
tsk.Text13 = updatesheet
End If
End If
Next tsk
End Sub
There are two ways to use the Excel VLookup (and similar functions like Match) with VBA, and they differ.
Application.VLookup (the version you are using) will return an error value Error 2042 if the search term cannot be found. This is not a runtime error, this is a return value. Error values are a special data type in VBA (they are not strings, the Error 2042 is just the representation of it). To be precise, this error is the #N/A that you see in Excel if a Vlookup fails.
You write the result into variable updatesheet, that is fine as it is declared as Variant, and a variant can hold an error value. However, now you check if an error occurred and as this is not the case, it will try to assign the error value to tsk.Text13 and this gives you a type mismatch error (I assume that tsk.Text13 expects a string).
Instead of checking for a runtime error as you do, you need to check if updatesheet contains an error value, this is done using the IsError-function. In this case, you could also use the Application.IsNA()-function.
The alternative is to use WorksheetFunction.Vlookup, this will throw a runtime error if can't find the search term, and you need to wrap this into Error handling.
Use either the one or the other method:
updatesheet = appXLS.VLookup(Param, rg, 16, False)
If appXLS.IsNA(updatesheet) Then
tsk.text13 = "No match 32"
Else
tsk.text13 = updatesheet
End If
updatesheet = "No match 32"
On Error Resume Next
updatesheet = appXLS.WorksheetFunction.VLookup(Param, rg, 16, False)
On Error GoTo 0
tsk.text13 = updatesheet
For further reading, I recommend https://rubberduckvba.wordpress.com/2021/02/15/worksheetfunction-and-errors/

Error handling in a loop using Resume Next

as a newcomer to VBA any help would be appreciated. The basic point of my program is to loop through columns of the spreadsheet and count the number of non-blank cells in each column, within a specified range.
Here is an example of what my spreadsheet looks like.
1
2
3
1
thing
2
thing
3
thing
When all the cells in the column are blank, VBA throws out a 1004 error, no cells found. What I want to do is say, if a 1004 error occurs, set the count of the non-blank cells (nonBlank = 0) equal to zero, and if no error occurs, count normally. In something like Python, I'd use try/except. Here is my attempt.
For i = 1 To 3
On Error Resume Next
Set selec_cells = Sheet1.Range(Sheet1.Cells(FirstRow, i), Sheet1.Cells(LastRow, i)).SpecialCells(xlCellTypeVisible).Cells.SpecialCells(xlCellTypeConstants)
If Err.Number <> 1004 Then
nonBlank = 0
Else
nonBlank = selec_cells.Count
End If
On Error GoTo -1
Next i
My issue is, when I run this code, it spits out 0 every time, even though column 2 should return 3. Thank you!
Edit: selec_cells is what throws out the error.
Error Handling
There is no On Error Goto -1 in VBA, it's a VB thing (those are links to different pages). A tip would be if you google VBA stuff, just put VBA in front of what you're looking for.
When using On Error Resume Next (defer error trapping), you should 'apply' it on a line or two maximally and 'close' with On Error Goto 0 (disable error trapping) or with another error handler.
Your usage of On Error Resume Next is unacceptable because in this particular case we can test the range: 1. defer error handling, 2. try to set the range, 3. disable error handling. If there was an error the range will not be set hence If Not rg Is Nothing Then which could be translated to something like 'If rg Is Something Then' (double negation) or If a reference to a range has been created Then.
The second solution illustrates a case where the main error handler is handling all errors except the SpecialCells error which has its own error handler. Resume Next means continue with the line after the line where the error occurred. Note the Exit Sub line and note Resume ProcExit where the code is redirected to a label.
The following illustrates two ways how you could handle this. At this stage, I would suggest you use the first one and remember to use the 'closing' On Error Goto 0 whenever you use On Error Resume Next (a line or two).
The Code
Option Explicit
Sub testOnErrorResumeNext()
Const FirstRow As Long = 2
Const LastRow As Long = 11
Dim rg As Range ' ... additionally means 'Set rg = Nothing'.
Dim nonBlank As Long ' ... additionally means 'nonBlank = 0'.
Dim j As Long
For j = 1 To 3 ' Since it's a column counter, 'j' or 'c' seems preferred.
' Since you're in a loop, you need the following line.
Set rg = Nothing
On Error Resume Next
Set rg = Sheet1.Range(Sheet1.Cells(FirstRow, j), _
Sheet1.Cells(LastRow, j)).SpecialCells(xlCellTypeVisible) _
.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not rg Is Nothing Then
nonBlank = rg.Cells.Count
Else
' Since you're in a loop, you need the following line.
nonBlank = 0
End If
Debug.Print nonBlank
Next j
End Sub
Sub testOnError()
On Error GoTo clearError
Const FirstRow As Long = 2
Const LastRow As Long = 11
Dim rg As Range ' ... additionally means 'Set rg = Nothing'.
Dim nonBlank As Long ' ... additionally means 'nonBlank = 0'.
Dim j As Long
For j = 1 To 3 ' Since it's a column counter, 'j' or 'c' seems preferred.
' Since you're in a loop, you need the following line.
Set rg = Nothing
On Error GoTo SpecialCellsHandler
Set rg = Sheet1.Range(Sheet1.Cells(FirstRow, j), _
Sheet1.Cells(LastRow, j)).SpecialCells(xlCellTypeVisible) _
.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo clearError
If Not rg Is Nothing Then
nonBlank = rg.Cells.Count
End If
Debug.Print nonBlank
Next j
ProcExit:
Exit Sub ' Note this.
SpecialCellsHandler:
' Since you're in a loop, you need the following line.
nonBlank = 0
Resume Next
clearError:
MsgBox "Run-time error '" & Err.Number & "': " & Err.Description
Resume ProcExit
End Sub
My preference is, wherever possible, to encapsulate the line of code that may cause an error in its own function. The function returns true or false to indicate whether or not there is an error and an out parameter is used to return the value that you want.
This keeps the error testing confined within a very short well defined function.
Sub ttest()
Dim mySheet As Excel.Worksheet
Set mySheet = ThisWorkbook.Sheet1
Dim myIndex As Long
Dim myNonBlank as long
For myIndex = 1 To 3
If AllCellsAreBlank(mySheet.Range(ThisWorkbook.Sheet1.Cells(myFirstRow, myIndex), mySheet.Cells(myLastRow, myIndex)), myIndex, mySelectCells) Then
myNonBlank = 0
Else
myNonBlank = mySelectCells.Count
End If
Next
End Sub
Public Function AllCellsAreBlank(ByRef ipRange As Excel.Range, ByVal ipIndex As Long, ByRef opSelectCells As Range) As Boolean
On Error Resume Next
set opSelectCells = ipRange.SpecialCells(xlCellTypeVisible).Cells.SpecialCells(xlCellTypeConstants)
AllCellsAreBlank = Err.Number <> 0
On Error GoTo 0
End Function
For reference the prefixes I use are
ip: for an input only parameter
iop: for an input parameters that will be changed by the method
op: for a parameter only used to return a value
my: any variable declared within a Method.
I's also suggest you acquire the habit of meaningful descriptive names, myRow, myCol are much more meaningful than i,j, and of ensuring you use fully qualified references rather than the implicit use of the activesheet.

Runtime error 1004 - Unable to get the PageRange property of the PivotTable class

When the code is applied to a pivot table that has no PageRange property the code fails with the error in the title
I tried to apply a boolean variable to
sh.PivotTables(i).PageRange
but that did not work either
Sub TestPivotPaste2()
Dim wb As Workbook
Dim sh As Worksheet
Set wb = ActiveWorkbook
Set sh = wb.Worksheets(7)
c = sh.PivotTables.Count
If c > 0 Then
For i = 1 To c
If Not sh.PivotTables(i).PageRange.Count = 0 Then
Debug.Print c
Else
GoTo nextpiv
End If
nextpiv:
Next i
Else
MsgBox ("NoPivot")
End If
End Sub
the expected result is to be able to discern the pivot tables where the PageRange property is true or false, but it only works when the range exists.
Try this function
Function pageRangeExists(pt as PivotTable) as Boolean
Dim test as Range
On Error Resume Next
Set test = pt.PageRange
On Error Go To 0
pageRangeExists = Not test Is Nothing
End Function
Since PageRange is a range object, you have to test if the range exists or is valid first, as trying to act against a range that is not there will produce an error.
And with that your for loop can be simplified
For i = 1 To c
If pageRangeExists(sh.PivotTables(i)) Then
Debug.Print c
End If
Next i
The GoTo statement is superfluous as it is logic already embedded in a for loop.

check if array is empty (vba excel)

These if ... then statements are getting the wrong results in my opinion. The first is returning the value 'false' when it should be 'true'. The fourth returns the right value. The second and third return an error.
Sub empty_array()
Dim arr1() As Variant
If IsEmpty(arr1) Then
MsgBox "hey"
End If
If IsError(UBound(arr1)) Then
MsgBox "hey"
End If
If IsError(Application.match("*", (arr1), 0)) Then
MsgBox "hey"
End If
ReDim arr1(1)
arr1(1) = "hey"
If IsEmpty(arr1) Then
MsgBox "hey"
End If
End Sub
Arr1 becomes an array of 'Variant' by the first statement of your code:
Dim arr1() As Variant
Array of size zero is not empty, as like an empty box exists in real world.
If you define a variable of 'Variant', that will be empty when it is created.
Following code will display "Empty".
Dim a as Variant
If IsEmpty(a) then
MsgBox("Empty")
Else
MsgBox("Not Empty")
End If
Adding into this: it depends on what your array is defined as. Consider:
dim a() as integer
dim b() as string
dim c() as variant
'these doesn't work
if isempty(a) then msgbox "integer arrays can be empty"
if isempty(b) then msgbox "string arrays can be empty"
'this is because isempty can only be tested on classes which have an .empty property
'this do work
if isempty(c) then msgbox "variants can be empty"
So, what can we do? In VBA, we can see if we can trigger an error and somehow handle it, for example
dim a() as integer
dim bEmpty as boolean
bempty=false
on error resume next
bempty=not isnumeric(ubound(a))
on error goto 0
But this is really clumsy... A nicer solution is to declare a boolean variable (a public or module level is best). When the array is first initialised, then set this variable.
Because it's a variable declared at the same time, if it loses it's value, then you know that you need to reinitialise your array.
However, if it is initialised, then all you're doing is checking the value of a boolean, which is low cost. It depends on whether being low cost matters, and if you're going to be needing to check it often.
option explicit
'declared at module level
dim a() as integer
dim aInitialised as boolean
sub DoSomethingWithA()
if not aInitialised then InitialiseA
'you can now proceed confident that a() is intialised
end sub
sub InitialiseA()
'insert code to do whatever is required to initialise A
'e.g.
redim a(10)
a(1)=123
'...
aInitialised=true
end sub
The last thing you can do is create a function; which in this case will need to be dependent on the clumsy on error method.
function isInitialised(byref a() as variant) as boolean
isInitialised=false
on error resume next
isinitialised=isnumeric(ubound(a))
end function
#jeminar has the best solution above.
I cleaned it up a bit though.
I recommend adding this to a FunctionsArray module
isInitialised=false is not needed because Booleans are false when created
On Error GoTo 0 wrap and indent code inside error blocks similar to with blocks for visibility. these methods should be avoided as much as possible but ... VBA ...
Function isInitialised(ByRef a() As Variant) As Boolean
On Error Resume Next
isInitialised = IsNumeric(UBound(a))
On Error GoTo 0
End Function
I would do this as
if isnumeric(ubound(a)) = False then msgbox "a is empty!"
I may be a bit late, but following simple stuff works with string arrays:
Dim files() As String
files = "..." 'assign array
If Not Not files Then
For i = LBound(files) To UBound(files)
'do stuff, array is not empty
Next
End If
That's all the code for this.
Above methods didn´t work for me. This did:
Dim arrayIsNothing As Boolean
On Error Resume Next
arrayIsNothing = IsNumeric(UBound(YOUR_ARRAY)) And False
If Err.Number <> 0 Then arrayIsNothing = True
Err.Clear
On Error GoTo 0
'Now you can test:
if arrayIsNothing then ...
this worked for me:
Private Function arrIsEmpty(arr as variant)
On Error Resume Next
arrIsEmpty = False
arrIsEmpty = IsNumeric(UBound(arr))
End Function
The problem with VBA is that there are both dynamic and static arrays...
Dynamic Array Example
Dim myDynamicArray() as Variant
Static Array Example
Dim myStaticArray(10) as Variant
Dim myOtherStaticArray(0 To 10) as Variant
Using error handling to check if the array is empty works for a Dynamic Array, but a static array is by definition not empty, there are entries in the array, even if all those entries are empty.
So for clarity's sake, I named my function "IsZeroLengthArray".
Public Function IsZeroLengthArray(ByRef subject() As Variant) As Boolean
'Tell VBA to proceed if there is an error to the next line.
On Error Resume Next
Dim UpperBound As Integer
Dim ErrorNumber As Long
Dim ErrorDescription As String
Dim ErrorSource As String
'If the array is empty this will throw an error because a zero-length
'array has no UpperBound (or LowerBound).
'This only works for dynamic arrays. If this was a static array there
'would be both an upper and lower bound.
UpperBound = UBound(subject)
'Store the Error Number and then clear the Error object
'because we want VBA to treat unintended errors normally
ErrorNumber = Err.Number
ErrorDescription = Err.Description
ErrorSource = Err.Source
Err.Clear
On Error GoTo 0
'Check the Error Object to see if we have a "subscript out of range" error.
'If we do (the number is 9) then we can assume that the array is zero-length.
If ErrorNumber = 9 Then
IsZeroLengthArray = True
'If the Error number is something else then 9 we want to raise
'that error again...
ElseIf ErrorNumber <> 0 Then
Err.Raise ErrorNumber, ErrorSource, ErrorDescription
'If the Error number is 0 then we have no error and can assume that the
'array is not of zero-length
ElseIf ErrorNumber = 0 Then
IsZeroLengthArray = False
End If
End Function
I hope that this helps others as it helped me.
I'm using this
If UBound(a) >= 0 Then
' not empty
Else
' empty... UBound(a) = -1
End If
IsEmpty(a) did not work for me... I hate VBA
Dim arr() As Variant
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' raises error
arr = Array()
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' -1
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = "test"
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' 0
The below function works for both static and dynamic arrays.
Function array_Empty(testArr As Variant) As Boolean
Dim i As Long, k As Long, flag As Long
On Error Resume Next
i = UBound(testArr)
If Err.Number = 0 Then
flag = 0
For k = LBound(testArr) To UBound(testArr)
If IsEmpty(testArr(k)) = False Then
flag = 1
array_Empty = False
Exit For
End If
Next k
If flag = 0 Then array_Empty = True
Else
array_Empty = True
End If
End Function
Tente isso:
Function inic(mtz As Variant) As Boolean
On Error Resume Next
Dim x As Boolean
x = UBound(mtz): inic = x
End Function
...
if inic(mymtz) then
debug.print "iniciada"
else
debug.print "não iniciada"
end if

VBA error handling not working when function being called generates error

I am iterating through rows,and looking up the first column of each row(name) using a different function for finding his marks.
For each "name" there is a particular entry in a different table("marks") which can also be blank or "-"
Sub main()
On error goto errorhandler
Dim name as string
Dim marks as double
Dim source as range
Dim runs as integer
runs = 1
Set source = Sheets("input").Range("$A$2")
i=1
Do until source.offset(i,0) = "" 'iterate through rows
name = source.offset(i,0)
marks = find(name)
do until runs * marks > 100
runs = runs + 1 'since marks is not defined;runs overflows
Loop
'a lot of code which relies on marks
errorhandler:
i = i + 1
Loop
End Sub
Function find(name as string) as double
find = application.vlookup(name,Sheets("values").Range("$A$2,$C$5"),2,0)
End function
now as i said the value in column 2 of that table can also be blank or "-" and thus results in error Runtime error 13 "Type mismatch"
i even tried putting on error statement inside the loop
VBA should normally search for error handling in the calling function i.e "main" but its not doing so
TRIED AND TESTED
Sub main()
On Error GoTo errorhandler
Dim name As String
Dim marks As Double
Dim source As Range
Set source = Sheets("input").Range("$A$2")
i = 1
Do Until source.Offset(i, 0) = "" 'iterate through rows
name = source.Offset(i, 0)
marks = find(name)
Debug.Print marks
i = i + 1
Loop
Exit Sub
errorhandler:
MsgBox Err.Description
End Sub
Function find(name As String) As Double
find = Application.WorksheetFunction.VLookup(name, Sheets("values").Range("$A$2:$C$5"), 2, False)
End Function
EDIT: Kartik, Sorry, I didn't see that you have already accepted the answer.
FOLLOWUP
actually i dont want to print any error message instead straightaway skip to the next iteration – Kartik Anand 14 secs ago
In that case you are handling error in the wrong section ;)
Try this
Sub main()
Dim name As String
Dim marks As Double
Dim source As Range
Set source = Sheets("input").Range("$A$2")
i = 1
Do Until source.Offset(i, 0) = "" 'iterate through rows
name = source.Offset(i, 0)
marks = find(name)
Debug.Print marks
i = i + 1
Loop
End Sub
Function find(name As String) As Double
On Error GoTo earlyexit
find = Application.WorksheetFunction.VLookup(name, Sheets("values").Range("$A$2:$C$5"), 2, False)
Exit Function
earlyexit:
find = 0
End Function
Add an Err.Clear after errorhandler:
Also, see the Excel help on Err.Clear which reccomends On Error Resume Next
together with If Err.Number <> 0 Then
This will produce much clearer code
Something like
Sub main()
On Error Resume Next
Dim name As String
Dim marks As Double
Dim source As Range
Set source = Sheets("input").Range("$A$2")
i = 1
Do Until source.Offset(i, 0) = "" 'iterate through rows
name = source.Offset(i, 0)
marks = Find(name)
If Err.Number <> 0 Then
Err.Clear
Else
' Your other code for non-error case here
End If
i = i + 1
Loop
End Sub

Resources