My function's intent is explained in the docstring. However, when I run it, I get a "Run-Time error '91': Object variable or With block variable not set", and a line of code is highlighted, as indicated below. I cannot find the source of this issue, especially since I am rather new to VBA. Any help would be greatly appreciated!
'==============================|Range_Collection FUNCTION|=============================='
' Given a collection and a range, add each value in that range to the collection, except
' for False values.
Function Range_Collection(col As Collection, rng As Range) As Collection
Dim Val As Variant
For Each Val In rng
If Not Val.Value = False Then
col.Add Val.Value ;************** THIS CODE IS HIGHLIGHTED************
End If
Next Val
Set Range_Collection = col
End Function
Let's say your worksheet looks like this
This is what I get when I run the code
Further to my comment, see this
The syntax is col.add "Item","Key". The key has to be unique. If you have duplicate values then then use OERN as I suggested or use a unique key.
Sub Sample()
Dim c As New Collection
For Each itm In Range_Collection(c, Range("A1:A5"))
Debug.Print itm
Next
End Sub
Function Range_Collection(col As Collection, rng As Range) As Collection
Dim rVal As Variant
For Each rVal In rng
If Not rVal.Value = False Then
On Error Resume Next
col.Add rVal.Value, CStr(rVal.Value)
On Error GoTo 0
End If
Next rVal
Set Range_Collection = col
End Function
Change Dim Val As Variant to Dim Val As Range
Also, watch out for this little "potential language oddity" ... (in any language)
When you wrote:
If Not Val.Value = False Then
... then you no doubt intended to say: (note the parentheses, carefully ...)
If Not (Val.Value = False) Then
... (in other words, "not equal to") ...
But most grammars actually bind the Not operator more tightly than a relational-operator such as =, producing what could be this actual interpretation, with no syntax-errors:
If (Not Val.Value) = False Then
... (in other words, "if Val.Value is True!")
The compiler judges your statement to be "syntactically and semantically correct," as in fact it is. But its interpretation of what you have written might not be what you thought it was. If you include the parentheses as I have shown above, all ambiguity is removed.
If you want "not equal to", always use the appropriate operator.
When using logical operators, use parentheses plentifully to make your intentions clear, both to the compiler and to other people.
Oddly enough, this sort of issue led to a bug in the very first program that I ever wrote: which "was 6 lines long, took me 6 months to write (in BASIC for a timesharing computer, nevermind how long ago now), and had a bug in it."
Related
I'm still fairly new to VBA and struggling with its limitations (and mine!). Here's my code:
Sub updateCache(CacheKey As String, CacheValue As Variant)
Dim DataCacheWorksheet As Worksheet, CacheRange As Range, Found As Variant, RowNum As Integer
Set DataCacheWorksheet = ThisWorkbook.Worksheets("DataCache")
Set CacheRange = DataCacheWorksheet.Range("A1:B999")
Set Found = CacheRange.Find(What:=CacheKey)
If Found Is Nothing Then
RowNum = CacheRange.Cells(Rows.Count, 2).End(xlUp).Row
DataCache.Add CacheKey, CacheValue
On Error Resume Next
DataCacheWorksheet.Cells(1, 1).Value = CacheKey
DataCacheWorksheet.Cells(1, 2).Value = CacheValue
Else
'Do other things
End If
End Sub
When I step through the code, Excel simply exits the sub at the line DataCacheWorksheet.Cells(1, 1).Value = CacheKey, with no error. So, two questions:
What's the bug that's preventing the value from being updated?
Why does Excel ignore my On Error command?
Edit: If I run the line in the IDE's "Immediate" box, I get the error "Run-time error '1004' Application-defined or object-defined error. I get the same error regardless of the value of CacheKey (I tried Empty, 1234 and "Hello").
Edit 2: If I modify the sub so that CacheKey and CacheValue are hardcoded and the reference to DataCache is removed, and then I run the sub standalone it works. So why doesn't it work when called from another function? Is it possible that Excel is locking cells while doing calculations?
Not sure if this applies, but you mentioned you were calling this macro from another function. If you are calling it from a function, depending on how you are calling it, that would explain your problem. For example, a worksheet function entered into a cell cannot modify another cell on the worksheet. And the attempt to do so will result in the macro merely exiting at that point, without throwing a VBA error.
How to work around this depends on specifics you have yet to share. Sometimes, worksheet event code can be useful.
Ok, wasn't about to write an answer, but there are 3 things you should modify in your code:
Found As Range and not As Variant
RowNum As Long in case it's a row after ~32K
To trap errors usually On Error Resume Next won't help you, it will just jump one line of code. You need to handle the error situation.
Modified Code
Sub updateCache(CacheKey As String, CacheValue As Variant)
Dim DataCacheWorksheet As Worksheet, CacheRange As Range, Found As Range, RowNum As Long ' < use Long instead of Integer
Set DataCacheWorksheet = ThisWorkbook.Worksheets("DataCache")
Set CacheRange = DataCacheWorksheet.Range("A1:B999")
Set Found = CacheRange.Find(What:=CacheKey)
If Found Is Nothing Then ' check if not found in cache (*Edit 1)
RowNum = CacheRange.Cells(Rows.Count, 2).End(xlUp).Row
DataCache.Add CacheKey, CacheValue ' I assume you have a `Dictionary somewhere
' On Error Resume Next <-- Remove this, not recommended to use
DataCacheWorksheet.Cells(1, 1).Value = CacheKey
DataCacheWorksheet.Cells(1, 2).Value = CacheValue
Else
'Do other things
End If
End Sub
I am trying to write a small piece of code that selects all cells containing "D" in the range A1:J10. Sorry if the code below is sub-optimal for the purpose, but I am trying to use this as a means of learning the language. There seems to be no obvious error in the code (to me), but it says 'Invalid procedure call or argument' when I try to run it.
Option Explicit
Dim t As Range
Dim finalrange As Range
Sub selectallbattleships()
For Each t In Range("A1:J10")
If t.Value = "D" Then Set finalrange = Application.Union(finalrange, t)
Next t
finalrange.Select
End Sub
You have to give finalrange an initial Range, otherwise it starts off as Nothing. The code is failing at Application.Union(finalrange, t) because it's trying to Union Nothing.
There are a couple of issues here.
First your Dim statements should be inside the sub. Next, you cannot union nothing, so you need to check if finalrange has been assigned to anything yet, then decide how to treat it - in this case if it hasn't then just assign it to t, otherwise union. Lastly, you do not need 'Application.' before union.
Sub selectallbattleships()
Dim t As Range
Dim finalrange As Range
For Each t In Range("A1:J10")
If t.Value = "D" Then
If finalrange Is Nothing Then
Set finalrange = t
Else
Set finalrange = Union(finalrange, t)
End If
End If
Next t
finalrange.Select
End Sub
I have a method to execute a Distinct Result from a Table Column on a Worksheet.
The result of the Method will go into a Data-Validation listbox in a cell. I have two needs right now that require me to "dummy mitigate" the method's use, by limiting the number of columns passed to the method by one. This part i can get done, what i would like to do is have it so that if there are multiple columns in the Range, then it "pukes" on the user, stating that an illegal function call was made from "Worksheet"."Cell" and to alert the IT Support to resolve the problem.
Getting the Worksheet is great and the easy part. Its more of getting the reference to the Calling Cell without explicitely forcing the IT Support to pass the Cell as a value to the method.
Any ideas on how to extract the Calling Cell?
Ultimately this method will be used across several worksheets to perform the same logic with different ranges being passed to it.
Edited 2012-09-24 10:30am CST
Here is my implementation so far, havent utilized the Application.Caller method into it.
Function UniqueValues(ws As Worksheet, col As String) As Variant
Dim rng As Range: Set rng = ws.Range(col)
Dim dict As New Scripting.Dictionary
If Not (rng Is Nothing) Then
Dim cell As Range, val As String
For Each cell In rng.Cells
val = CStr(cell.Value)
If Not dict.Exists(val) Then
dict.Add val, val
End If
Next cell
End If
'Return value
UniqueValues = dict.Items
End Function
This method is already being used in code-behind logic. I will be copying this logic and making it apart of the Application.Volatile segment for the Excel Workbook i am working on. Will be similar but not the same.
Here is the current design, not much but what i am workgin with atm.
Function DistinctValues(rng As Range)
Application.Volatile True
If rng.Columns.Count > 1 Then
Err.Raise -1542376, rng.Worksheet.name, "An invalid function call was made!"
End If
End Function
Application.Caller returns the cell that called a function. See this MSDN definition.
Suppose I have some module in vba with some variable r of type Range. Suppose that, at some point, I store a Range object there (e.g. the active cell). Now my question: What happens to the value of r if the user deletes the cell (the cell, not only its value)?
I tried to figure this out in VBA, but without success. The result is strange. r is not Nothing, the value of r is reported to be of type Range, but if I try to look at its properties in the debugger window, each property's value is reported as "object required".
How can I, programmatically, determine whether variable r is in this state or not?
Can I do this without generating an error and catching it?
Nice question! I've never thought about this before, but this function will, I think, identify a range that was initialzed - is not Nothing - but is now in the "Object Required" state because its cells were deleted:
Function RangeWasDeclaredAndEntirelyDeleted(r As Range) As Boolean
Dim TestAddress As String
If r Is Nothing Then
Exit Function
End If
On Error Resume Next
TestAddress = r.Address
If Err.Number = 424 Then 'object required
RangeWasDeclaredAndEntirelyDeleted = True
End If
End Function
You can test is like this:
Sub test()
Dim r As Range
Debug.Print RangeWasDeclaredAndEntirelyDeleted(r)
Set r = ActiveSheet.Range("A1")
Debug.Print RangeWasDeclaredAndEntirelyDeleted(r)
r.EntireRow.Delete
Debug.Print RangeWasDeclaredAndEntirelyDeleted(r)
End Sub
I believe that when you use the Set keyword in VBA, it creates a pointer in the background to the worksheet's Range object in the worksheet you specified (each cell being an object in the collection of Cells of the Worksheet for a given Range). When the range is deleted while you are still referencing it in memory, the memory for the object that the Range variable was pointing to has been deallocated.
However, your Range variable most-likely still contains the pointer to the recently removed Range object, which is why it isn't nothing, but whatever it's pointing to doesn't exist anymore, which causes problems when you try to use the variable again.
Check out this code to see what I mean:
Public Sub test2()
Dim r As Excel.Range
Debug.Print ObjPtr(r) ' 0
Set r = ActiveSheet.Range("A1")
Debug.Print ObjPtr(r) ' some address
r.Value = "Hello"
r.Delete
Debug.Print ObjPtr(r) ' same address as before
End Sub
Check out this article for more info about ObjPtr():
http://support.microsoft.com/kb/199824
So while you have a valid address to an object, unfortunately the object doesn't exist anymore since it has been deleted. And it appears that "Is Nothing" just checks for an address in the pointer (which I think VBA believes that the variable is "Set").
As to how to get around this problem, unfortunately I don't see a clean way of doing it at the moment (if anyone does find an elegant way to handle this, please post it!). You can use On Error Resume Next like so:
Public Sub test3()
Dim r As Excel.Range
Debug.Print ObjPtr(r) ' 0
Set r = ActiveSheet.Range("A1")
Debug.Print ObjPtr(r) ' some address
r.Value = "Hello"
r.Delete
Debug.Print ObjPtr(r) ' same address as before
On Error Resume Next
Debug.Print r.Value
If (Err.Number <> 0) Then
Debug.Print "We have a problem here..."; Err.Number; Err.Description
End If
On Error GoTo 0
End Sub
How can I, programmatically, determine whether variable r is in this
state or not?
Can I do this without generating an error and catching it?
No.
To the best of my knowledge, you can't test for this condition reliably: not without raising and catching an error.
Your question has been noticed and discussed elsewhere: Two of the big names in Excel/VBA blogging (Dick Kusleika and Rob Bovey) have looked into it, and you may find something informative in there. But the answer's No.
All in all, a good question with rather worrying answer.
To test if a range object is currently invalid, I use this function:
Public Function InvalidRangeReference(r As Range) As Boolean
On Error Resume Next
If r.Count = 0 Then
InvalidRangeReference = Err
End If
End Function
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