Is it possible to use FindPrevious when searching with VBA code in a UDF? - vba

I am trying to use VBA for a UDF to manipulate its results based on the "Find" function as it's much quicker than polling every cell looking for results.
I have cut it right back to it's basics to reproduce the error and I still get "Object variable or With block variable not set" error on this part SearchRange.FindPrevious.Address (You have to put a stop on the line and step it to get the error, UDF's just quit out without returning the error outside of debug mode)
Here's the kicker, I get the error when trying to use the UDF in a sheet like so: =testfind("3206-1",E:E) however when I use it in the immediate window in the VBE like so: ?testfind("3206-1",Range("E:E")) i get the correct result of $E$15295 without error.
Code is:
Function TestFind(FindString As String, SearchRange As Range)
Dim ActiveAddress As Range
Set ActiveAddress = SearchRange.Find(FindString)
TestFind = SearchRange.FindPrevious.Address
End Function
Modified with L42's changes and now it works:
Function TestFind(FindString As String, SearchRange As Range)
Dim ActiveAddress As Range
Set ActiveAddress = SearchRange.Find(FindString)
TestFind = SearchRange.Find(FindString, , , , , xlPrevious).Address
End Function

Edit1:
This code
TestFind = SearchRange.FindPrevious.Address
and this as previously suggested:
TestFind = SearchRange.FindPrevious(ActiveAddress).Address
doesn't work when you use it as worksheet function as what Dan experienced.
Below doesn't directly answer the question but just an alternative.
Alternative: Change the SearchDirection argument in the Find method.
Function TestFind2(FindString As String, SearchRange As Range)
Dim ActiveAddress As Range
Set ActiveAddress = SearchRange.Find(FindString, , , , , xlPrevious)
TestFind2 = ActiveAddress.Address
End Function
Note: You need to add error handler to trap searches with no match found.
How to test:
Sub marine()
Debug.Print TestFind(4, [A:A])
End Sub

Related

EXCEL VBA - Object Variable or With Block Variable Not Set

I'm currently developing a function that will search for the row number based on a string input that I have. In the following function however I get the error as stated in the title and i have no idea what to do about this :L
Here is the Find Row Function
Function MPNTRowECU(ByVal ECUVariantName) As Range
Debug.Print ECUVariantName
Dim wsMPNT As Worksheet
Set wsMPNT = Worksheets("Module Part Number Tracker")
MPNTRowECU = wsMPNT.Range("C:C").Find(What:=ECUVariantName, LookIn:=xlValues, SearchOrder:=xlByRows)
End Function
The Debug.Print line is there to make sure that ECUVariantName is indeed a string and it does return the string that i have everytime. At the MPNTRowECU is where I get the error. Any suggestions guys? Fairly new to VBA
Try the Function code below, instead of returning the Range, I modifed your Function to return the Row number (as described in your post).
Also, you need to make sure, that Find is successful , by using the If Not MPNTRng Is Nothing Then criteria.
Code
Function MPNTRowECU(ByVal ECUVariantName) As Long
Dim MPNTRng As Range
Debug.Print ECUVariantName
Dim wsMPNT As Worksheet
Set wsMPNT = Worksheets("Module Part Number Tracker")
Set MPNTRng = wsMPNT.Range("C:C").Find(What:=ECUVariantName, LookIn:=xlValues, SearchOrder:=xlByRows)
If Not MPNTRng Is Nothing Then ' confirm that Find was successful
MPNTRowECU = MPNTRng.Row
Else ' Find failed to find "ECUVariantName"
MPNTRowECU = -10000 ' just put a high negative value to raise an error
End If
End Function

Why does IfError return error?

I'm trying to create a wrapper for the INDEX/MATCH lookup method (which is faster/better than the regular VLOOKUP method) by creating a custom function and loading it afterwards as an add-in.
So far so good, but my desired behavior is that, when the value to be looked up is not found, it should return blank ("") and not #VALUE!. So I am trying to use the IfError WorksheetFunction in order to achieve this the same way I would on an Excel sheet:
Function FastLookup(parLookupKey As Variant, parLookupRange As Range, parReturnRange As Range) As Variant
FastLookup = Application.WorksheetFunction.IfError(Application.WorksheetFunction.Index(parReturnRange, Application.WorksheetFunction.Match(parLookupKey, parLookupRange, 0)), "")
End Function
Again, this still returns #VALUE! if a value is not found on the parLookupRange range.
Needless to say, if I use =IFERROR(FastLookup(H6,E3:E6,F3:F6),"") directly on the Excel sheet, it works.
Any ideas on how to make the VBA version of IfError work?
Because the error never makes it past the MATCH function in vba. As soon as that throws an error the code will stop.
Use this instead:
Function FastLookup(parLookupKey As Variant, parLookupRange As Range, parReturnRange As Range) As Variant
Dim t As Long
On Error Resume Next
t = Application.WorksheetFunction.Match(parLookupKey, parLookupRange, 0)
On Error GoTo 0
If t > 0 Then
FastLookup = parReturnRange(t)
Else
FastLookup = ""
End If
End Function
We now capture the error and ignore it. Then we test for it and return the correct value.

User Defined function not recognized

I've written a function in VBA that modifies the current VLOOKUP to return nothing instead of #N/A when a value is not found. The function works fine when I have it saved in a module in my active workbook but when I move it to my .xlam project the output is always #NAME?. I should also note that autocomplete does find the function when I begin typing it in a cell.
Here is the code I have so far:
Function NAVLOOKUP(val As Variant, rng As Range, ofst As Integer) As Variant
Dim temp As Variant
On Error Resume Next
temp = Application.WorksheetFunction.VLookup(val, rng, ofst, False)
If IsEmpty(temp) Then
NAVLOOKUP = ""
Else
NAVLOOKUP = temp
End If
End Function
It's pretty straightforward so I'm not sure what the problem is. I also made a dummy function in the same .xlam project that just adds an "S" to any value and it has been working with no problem.
Function ADDS(val As Variant) As String
ADDS = val & "S"
End Function
Since the second function works I am at a loss here. Any help would be appreciated.

Count visible blank cells using VBA?

When I enter the following function as a UDF in a cell:
Function VisibleBlankCells(r As Range) As Long
On Error Resume Next
VisibleBlankCells = Intersect(r.SpecialCells(xlCellTypeVisible), r.SpecialCells(xlCellTypeBlanks)).Count
On Error GoTo 0
End Function
r.SpecialCells(xlCellTypeBlanks) evaluates ALL cells in r as empty regardless of whether they contain text or not. What might be the cause of this and an alternative solution?
Get rid of the On Error Resume Next for a start - you should always assume that your code will fail and account for it accordingly, simply ignoring errors will just complicate matters.
Secondly ,there is no need to use Intersect - just identify the visible cells directly, and then use a further SpecialCells() method to identify the blank child cells.
Function VisibleBlankCells(r As Range) As Long
VisibleBlankCells = r.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeBlanks).Count
End Function
tested with this:
Sub test_code()
Dim r As Range: Set r = Selection
Debug.Print CountBlanks(r)
End Sub
Function CountBlanks(r As Range) As Long
CountBlanks = r.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeBlanks).Count
End Function
This kind of filter mechanism won't work in an UDF (see this for information on that). I suggest a looping inside your UDF:
Public Function VisibleBlankCells(rng As Range) As Long
Dim i As Integer
Dim cell As Range
i = 0
For Each cell In rng
If cell.Rows.Hidden = False And _
cell.Columns.Hidden = False And _
cell.Value = "" Then
i = i + 1
End If
Next
VisibleBlankCells = i
End Function
However, there may be some problems regarding the updating and functionality:
The value of the UDF only updates after editing the referenced range or calling other UDFs. So if you hide a column or row in that range, it won't have an instant effect
In the (working) execution of your code in a Sub, the visible cells (also) refer to yet unused cells in your worksheet to be "not visible". In my solution however, all cells that are not contained in a hidden row/column are considered visible.

Can I use VBA function to return a (dynamic) list of acceptable values into Excel's data validation?

For a given cell, I select Data/Validation and set Allow to "List". I now wish to set Source like so:
=rNames(REGS)
but that does not work (name not found). So I go Insert/Name/Define and create "REGNAMES" by simply assigning the formula above (no cell range). I then return to the Data/Validation and when I set Source like so:
=REGNAMES
Now I get "Source currently evaluates to error". Unfortunately, this error does not go away even after I ignore it. I can create a range formula in the sheet like so:
{=REGNAMES}
and drag this to the right across a couple cells and the rNames function faithfully returns
Option #1 | Options #2 | ...
That is, the function returns a range as intended.
I know that I can use macro code to manipulate the List setting for that cell out of VBA. I don't like these side-effects much. I would prefer a clean dependency tree built on functions. Any ideas how to get the Data/Validation to accept the array values returned from rNames?
Thanks.
PS: rNames returns the result range as a Variant, if that has any bearing.
I think the problem is that data validation dialog only accepts the following "lists":
an actual list of things entered directly into the Source field
a literal range reference (like $Q$42:$Q$50)
a named formula that itself resolves to a range reference
That last one is key - there is no way to have a VBA function just return an array that can be used for validation, even if you call it from a named formula.
You can write a VBA function that returns a range reference, though, and call that from a named formula. This can be useful as part of the following technique that approximates the ability to do what you actually want.
First, have an actual range somewhere that calls your arbitrary-array-returning VBA UDF. Say you had this function:
Public Function validationList(someArg, someOtherArg)
'Pretend this got calculated somehow based on the above args...
validationList = Array("a", "b", "c")
End Function
And you called it from $Q$42:$Q$50 as an array formula. You'd get three cells with "a", "b", and "c" in them, and the rest of the cells would have #N/A errors because the returned array was smaller than the range that called the UDF. So far so good.
Now, have another VBA UDF that returns just the "occupied" part of a range, ignoring the #N/A error cells:
Public Function extractSeq(rng As Range)
'On Error GoTo EH stuff omitted...
'Also omitting validation - is range only one row or column, etc.
Dim posLast As Long
For posLast = rng.Count To 1 Step -1
If Not IsError(rng(posLast)) Then
Exit For
End If
If rng(posLast) <> CVErr(xlErrNA) Then
Exit For
End If
Next posLast
If posLast < 1 Then
extractSeq = CVErr(xlErrRef)
Else
Set extractSeq = Range(rng(1), rng(posLast))
End If
End Function
You can then call this from a named formula like so:
=extractSeq($Q$42:$Q$50)
and the named formula will return a range reference that Excel will accept an allowable validation list. Clunky, but side-effect free!
Note the use of the keyword 'Set' in the above code. It's not clear from your question, but this might be the only part of this whole answer that matters to you. If you don't use 'Set' when trying to return a range reference, VBA will instead return the value of the range, which can't be used as a validation list.
I was just doing some research on accessing the contents of a Shapes dropdown control, and discovered another approach to solving this problem that you might find helpful.
Any range that can have a validation rule applied can have that rule applied programmatically. Thus, if you want to apply a rule to cell A1, you can do this:
ActiveSheet.Range("A1").Validation.Add xlValidateList, , , "use, this, list"
The above adds an in-cell dropdown validation that contains the items "use," "this," and "list." If you override the Worksheet_SelectionChange() event, and check for specific ranges within it, you can call any number of routines to create/delete validation rules. The beauty of this method is that the list referred to can be any list that can be created in VBA. I needed a dynamically-generated list of an ever-changing subset of the worksheets in a workbook, which I then concatenated together to create the validation list.
In the Worksheet_SelectionChange() event, I check for the range and then if it matches, fire the validation rule sub, thus:
Private Sub Worksheet_SelectionChange(ByVal Target as Range)
If Target.Address = "$A$1" Then
UpdateValidation
End If
End Sub
The validation list-builder code in UpdateValidation() does this:
Public Sub UpdateValidation()
Dim sList as String
Dim oSheet as Worksheet
For Each oSheet in Worksheets
sList = sList & oSheet.Name & ","
Next
sList = left(sList, len(sList) -1) ' Trim off the trailing comma
ActiveSheet.Range("A1").Validation.Delete
ActiveSheet.Range("A1").Validation.Add xlValidateList, , , sList
End Sub
And now, when the user clicks the dropdown arrow, he/she will be presented with the updated validation list.
Sounds like your rNames function is probably returning a 1-dimensional array (which will be treated as a row).
Try making your function return a column as a 1-based 2-dimensional array (Ansa(1,1) then Ansa(2,1) etc)
Couln't you rather use dynamic range names ? That's quite easy and does not require any vba.
For the future:
Following is then used in a named range and the named range set as the 'Data Validation' 'List' value
Function uniqueList(R_NonUnique As Range) As Variant
Dim R_TempList As Range
Dim V_Iterator As Variant
Dim C_UniqueItems As New Collection
On Error Resume Next
For Each V_Iterator In R_NonUnique
C_UniqueItems.Add "'" & V_Iterator.Parent.Name & "'!" & V_Iterator.Address, CStr(V_Iterator.Value2)
Next V_Iterator
On Error GoTo 0
For Each V_Iterator In C_UniqueItems
If R_TempList Is Nothing Then
Set R_TempList = Range(V_Iterator)
End If
Set R_TempList = Union(R_TempList, Range(V_Iterator))
Next V_Iterator
Set uniqueList = R_TempList
End Function
#user5149293 I higly appreciate your code, but I recommend to prevent the collection from throwing an error, when adding duplicate values. The usage of a custom formula in the data validation list or in Name-Manager-Formula prevents the code from using the vbe debugger, which makes it very hard to trace back errors here (I ran into this problem myself, when using your code).
I recommend to check the existence of key in the collection with a separate function:
Function uniqueList(R_NonUnique As Range) As Variant
'Returns unique list as Array
Dim R_TempList As Range
Dim V_Iterator As Variant
Dim C_UniqueItems As New Collection
For Each V_Iterator In R_NonUnique
'Check if key already exists in the Collection
If Not HasKey(C_UniqueItems, V_Iterator.Value2) Then
C_UniqueItems.Add Item:="'" & V_Iterator.Parent.Name & "'!" & V_Iterator.Address, Key:=CStr(V_Iterator.Value2)
End If
Next V_Iterator
For Each V_Iterator In C_UniqueItems
If R_TempList Is Nothing Then
Set R_TempList = Range(V_Iterator)
End If
Set R_TempList = Union(R_TempList, Range(V_Iterator))
Next V_Iterator
Set uniqueList = R_TempList
End Function
Function HasKey(coll As Collection, strKey As String) As Boolean
'https://stackoverflow.com/questions/38007844/generic-way-to-check-if-a-key-is-in-a-collection-in-excel-vba
Dim var As Variant
On Error Resume Next
var = coll(strKey)
HasKey = (Err.Number = 0)
Err.Clear
End Function