How can we typecast to an interface type in VBA?
Public Function createArray(ParamArray args() As Variant) As IArray
Dim arr As IArray
Set arr = New cRwArray
Select Case UBound(args)
'No params
Case -1
'Create decorator for empty array (no action required)
'1 params
Case 0
'Return array with range values
If TypeName(args(0)) = "cRwRange" Then
'Cast type
Dim range As iRange
range = ctype(args(0), iRange) 'IRange variable not defined
Call arr.readFromRange(range)
End Select
Set createArray = arr
End Function
Edit: this is strange.
Sub test()
Dim arr As IArray
Dim range As iRange
Set range = createRange("Sheet1", 20, 30)
Set arr = createArray(range)
End Sub
Yet, the type is not correctly set.
I checked this in the factory:
Debug.Print TypeName(args(0)) 'cRwRange, not the interface type?
You don't have to explicitly cast the object, as simple assignment will work:
Set range = args(0)
Additionally, TypeName returns the declared type of an object; if you want to know whether a given object implements a specific interface, you use TypeOf:
If TypeOf range Is iRange Then
for example. Also note that range is really not a good name for a variable in Excel... :)
Related
Is there a way to call Application.Worksheetfunction.Percentile(resultColl) where resultColl is a Collection?
I tried it and it returns a Unable to get Percentile property of the WorksheetFunction class error.
EDIT:
I tried to first convert that collection to array:
Function convertToArray(resultColl As Collection)
Dim resultArray() As Variant
ReDim resultArray(1 To resultColl.Count)
Dim i As Long
For i = 1 To resultColl.Count
resultArray(i) = resultColl.Item(i)
Next
convertToArray = resultArray
End Function
and use that array inside Percentile function:
Application.WorksheetFunction.Percentile( _
convertToArray(clientsColl.Item(1).getSumLosses), 0.99)
But now it returns a wrong number of arguments or invalid property assignment error at convertToArray function, even though in this test example I created, the function works fine:
Sub testConvert() 'this works fine
Dim testColl As Collection
Set testColl = New Collection
testColl.Add "apple"
testColl.Add "orange"
testColl.Add "pineapple"
Dim tempArray() As Variant
tempArray = convertToArray(testColl)
MsgBox (tempArray(1))
End Sub
clientsColl.Item(1).getSumLosses is a Collection:
inside Client class:
Private sumLosses As Collection 'the collection of numbers, a percentile of which I need to calculate
Private Sub Class_Initialize()
Set sumLosses = New Collection
End Sub
Public Property Get getSumLosses()
Set getSumLosses = sumLosses
End Property
EDIT2:
Changed the Percentile function call to this:
Dim tempArray() As Variant
tempArray = convertToArray(clientsColl.Item(1).getSumLosses)
resultDict.Add "UL: " & _
Application.WorksheetFunction.Percentile(tempArray, 0.99)
the error occurs on the line with resultDict.
Figured it out. The adding to the dictionary was done in a wrong way:
resultDict.Add "UL: " & _
Application.WorksheetFunction.Percentile(tempArray, 0.99)
instead of
resultDict.Add "UL: ", _
Application.WorksheetFunction.Percentile(tempArray, 0.99)
I'm assigning a value to a variable, where that value is either a number or an object instance depending on the result of a server request, as follows:
Sub assignVar()
Dim v As Variant
v = getValue
End Sub
Function getValue() As Variant
Dim result As Boolean
result = PostSomethingToServer()
If result Then
getValue = 1
Else
Set getValue = New Dictionary
getValue.Add "a", 1
End If
End Function
This works fine if I call assignVar(true), but if I call assignVar(false) then I get the error:
Wrong number of arguments or invalid property assignment
which is to be expected, because if getValue() returns an object, it should be assigned as set v = getValue. But if I write it this way, then I get a Type mismatch error because I'm trying to assign an integer using a Set statement.
How can I make sure that v gets assigned correctly for either return value of getValue()?
For now I'm resolving this by adding a ReturnValue class:
Option Explicit
Public value As Variant
Public valueIsObject As Boolean
Public Sub setup(value As Variant)
If IsObject(value) Then
Set Me.value = value
valueIsObject = True
Else
Me.value = value
valueIsObject = False
End If
End Sub
This way, I can rewrite the test methods as follows:
Sub assignVar()
Dim v As Variant
Dim rv as ReturnValue
Set rv = getValue
If rv.valueIsObject Then
Set v = rv.value
Else
v = rv.value
End If
End Sub
Function getValue() As ReturnValue
Dim result As Boolean
Dim dict as Dictionary
result = PostSomethingToServer()
set getValue=new ReturnValue
If result Then
getValue.setup 1
Else
Set dict = New Dictionary
dict.Add "a", 1
getValue.setup dict
End If
End Function
I have various settings tables in Excel, each with two column headings Parameter and Value.
I want to pass a specific table's name to a function getParameter that looks up a specific parameter's name in that table, returns the associated parameter's value, and performs all error handling, e.g. with the following code segment:
Function getParameter(....
...
Dim paramterValue as Variant
With Application
parameterValue = .Index([tableName[Value], .Match("parameterName", [tableName[Parameter], 0))
If Not IsError(parameterValue) then
...
Else
...
End If
End With
End Function
How do I define the appropriate function arguments and call the function?
Tables are in VBA selectable as ListObject Object. But those objects are on worksheet scope only. So we must know the worksheet on which the table is placed on to get it using wrksht.ListObjects(tableName).
To be more flexible, we could using Evaluate to evaluate the structured references:
Public Function getParameter(tableName As String, parameterName As Variant) as Variant
Dim parameterValue As Variant
Dim oRangeTValues As Range
Dim oRangeTParameters As Range
Set oRangeTValues = Evaluate("" & tableName & "[Value]")
Set oRangeTParameters = Evaluate("" & tableName & "[Parameter]")
With Application
parameterValue = .Index(oRangeTValues, .Match(parameterName, oRangeTParameters, 0))
If Not IsError(parameterValue) Then
getParameter = parameterValue
Else
getParameter = CStr(parameterValue)
End If
End With
End Function
This will be usable on all worksheets since the table names are on workbook scope in reality.
This is supposed to be used as User Defined Function using a cell formula like =getParameter("TableName","Parameter").
I'll try like this, identifying the sheet and the ListObject corresponding to your TableName :
Function getParameter(ByVal tableName As String, ByVal parameterName As String) As Variant
Dim parameterValue As Variant
Dim RgVal As Range
Dim wS As Worksheet
Dim LOTable As ListObject
Application.Volatile
Set wS = Evaluate(tableName).Parent
Set LOTable = wS.ListObjects(tableName)
Set RgVal = LOTable.DataBodyRange
With Application.WorksheetFunction
parameterValue = .Index(RgVal.Columns(2), .Match(parameterName, RgVal.Columns(1), 0))
End With 'Application.WorksheetFunction
If Not IsError(parameterValue) Then
getParameter = parameterValue
Else
'...
DoEvents
getParameter = CStr(parameterValue)
End If
End Function
Call in VBA :
Sub test_GetParameter()
Debug.Print getParameter("Table1", "testParam")
End Sub
Call in Excel :
= getParameter("Table1", "testParam")
#R3uk Axel Richter's code is sufficient, but yours also works.
I have a macro (code attached) which writes the data from two sheets into two variant arrays. It then uses a nested loop to look for all possible matches in the 2nd sheet on a piece of data in the 1st sheet.
When the first match is found one of the variant arrays appears to get wiped and I get a 'Subscript out of range'. this can happen when the data is being compared or when I subsequently try to pass data from that array to another procedure as a result of a match being found.
When I look in the Locals window, this array can change from showing the stored values to having the error message "Application-defined or object-defined error" in each index, or no indexes at all, or indexes with high negative numbers.
Regardless, if I try to investigate further while the code is in debug mode, Excel crashes ("Excel has encountered a problem and needs to close").
I have followed the advice at this link:
http://exceleratorbi.com.au/excel-keeps-crashing-check-your-vba-code/
...but to no avail.
I've stepped through the code and can trace it to the first time the data values being tested match. It happens for the same indexes (same i and j values) every time I run.
I'm using Excel 2013 on our office network.
Can anyone tell me what might be causing this or any tests I could perform to help narrow down the cause?
Could it be due to memory use? The arrays come out at about 15000 x 11 and 4000 x 6 and it's the smaller one that is being corrupted/failing.
Sub classTest()
Dim i As Long, j As Long
Dim CK_Array() As Variant, RL_Array() As Variant
Dim wb As Workbook
Dim CK_Data As Worksheet, RL_Data As Worksheet
Set wb = ThisWorkbook
Set CK_Data = wb.Sheets(1)
Set RL_Data = wb.Sheets(2)
Call getRange_BuildArray(CK_Array, CK_Data)
Call getRange_BuildArray(RL_Array, RL_Data) ' this sets the array that gets corrupted.
For i = 2 To UBound(CK_Array)
If Not IsEmpty(CK_Array(i, 6)) Then
For j = 2 To UBound(RL_Array)
If CK_Array(i, 6) = RL_Array(j, 4) Then ' array gets corrupted here or line below
Call matchFound(dResults, CStr(CK_Array(i, 1) & " | " & CK_Array(i, 5)), CStr(RL_Array(j, 2) & " " & RL_Array(j, 3)), CStr(RL_Array(j, 1)), CStr(RL_Array(1, 3))) ' or array gets corrupted here
End If
Next j
End If
Next i
End Sub
Private Sub getRange_BuildArray(arr As Variant, ws As Worksheet)
Dim endR As Long, endC As Long
Dim rng As Range
endR = ws.UsedRange.Rows.Count
endC = ws.UsedRange.Columns.Count
Set rng = Range(ws.Cells(1, 1), ws.Cells(endR, endC))
arr = rng
End Sub
EDIT:
As requested here is the code to the matchfound Sub. It's a dictionary, which holds class objects in a collection. Therefore I have also posted the class code below. I'm not yet making use of all of the class properties and methods as this issue has halted my testing.
Sub matchFound(dictionary As Object, nameCK As String, nameRL As String, RLID As String, dataitem As String)
Dim cPeople As Collection
Dim matchResult As CmatchPerson
If dictionary.exists(nameCK) Then
Set matchResult = New CmatchPerson
matchResult.Name = nameRL
matchResult.RLID = RLID
matchResult.matchedOn = dataitem
dictionary.Item(nameCK).Add matchResult
Else
Set cPeople = New Collection
Set matchResult = New CmatchPerson
matchResult.Name = nameRL
matchResult.RLID = RLID
matchResult.matchedOn = dataitem
cPeople.Add matchResult
dictionary.Add nameCK, cPeople
End If
End Sub
Class
Option Explicit
Private pName As String
Private pRLID As String
Private pMatchedOn As String
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(Name As String)
pName = Name
End Property
Public Property Get RLID() As String
RLID = pRLID
End Property
Public Property Let RLID(ID As String)
pRLID = ID
End Property
Public Property Get matchedOn() As String
matchedOn = pMatchedOn
End Property
Public Property Let matchedOn(textString As String)
pMatchedOn = textString
End Property
Public Sub MatchedOnString(datafield As String)
Dim text As String
text = Me.matchedOn & "|" & datafield
Me.Name = text
End Sub
I've reduced your problem to a Minimum, Verifiable and Complete Example.
The problem occurs when you assign the implicit default value of a range to a Variant variable that was passed as a Variant array.
Sub VariantArrayWTF()
Dim aBar() As Variant
Dim aFoo() As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
'aFoo() has now lost it's `+` sign in Locals window, but the bounds are still visible
Debug.Print aBar(1, 1)
'aFoo() has now lost its bounds in Locals Window
'aFoo(1,1) will produce subscript out of range
'Exploring the Locals Window, incpsecting variables, will crash Excel
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray As Variant)
'Note the use of theArray instead of theArray()
'Implicitly calling the default member is problematic
theArray = Sheet1.UsedRange
End Sub
There are a number of workarounds - I'd recommend using both:
Use Explicit calls to `Range.Value`
You can even make explicit call to the default member Range.[_Default]. The exact method isn't important, but it must be explicit.
Sub GetArray(ByRef theArray As Variant)
theArray = Sheet1.UsedRange.Value
End Sub
Avoid the use of `Call`, and pass common Variant definitions
Call is a deprecated statement, and can be omitted.
Declare the arrays and the helper functions' array argument consistently. That is, use () in all instances, or none.
Note the difference between declaring Dim aFoo() As Variant which is an array of Variants, and declaring Dim aFoo As Variant which is a Variant that can contain an array.
With Parentheses
Sub VariantArrayWTF()
Dim aBar() As Variant
Dim aFoo() As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
Debug.Print aBar(1, 1)
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray() As Variant)
theArray = Sheet1.UsedRange
End Sub
Without Parentheses
Sub VariantArrayWTF()
Dim aBar As Variant
Dim aFoo As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
Debug.Print aBar(1, 1)
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray As Variant)
theArray = Sheet1.UsedRange
End Sub
I have found the lines of code which were causing the problem. However, I cannot explain why it would necessarily cause a crash so I would appreciate other input on why this is happening.
When passing the RL and CK arrays to the getRange_Build Array sub I left out the brackets that would have denoted these variables as arrays.
The code was this...
Call getRange_BuildArray(CK_Array, CK_Data)
Call getRange_BuildArray(RL_Array, RL_Data)
...but should have been this
Call getRange_BuildArray(CK_Array(), CK_Data)
Call getRange_BuildArray(RL_Array(), RL_Data)
I'm thinking the reason that this didn't get flagged as a compile error is because the parameter in question in the getRange_BuildArray procedure itself also lacked the necessary brackets to denote an array.
It was this...
Private Sub getRange_BuildArray(arr As Variant, ws As Worksheet)
...it should have been this
Private Sub getRange_BuildArray(arr() As Variant, ws As Worksheet)
With those changes in place the macro is completing successfully for the full dataset and is not causing excel to crash.
As mentioned it would be great if someone could offer a more detailed breakdown of how this caused excel to crash.
I have a custom type as shown below,
Public Type TypeFieldColumn
iCol As Integer
dRow As Double
End Type
I then have the following sub routine
Private Sub PopulateWorksheet()
Dim wsTS As Worksheet
Dim clsData As New clsDatabase
Dim rsTS As New ADODB.Recordset
Dim Fields() As TypeFieldColumn
Set wsTS = ThisWorkbook.Sheets(SomeName)
Set rsTS = clsData.SomeMethod()
Fields = FindFactorColumns(rsTS, wsTS)
End Sub
which calls the function below
Private Function FindFactorColumns(rsTS As ADODB.Recordset, wsTS As Worksheets) As TypeFieldColumn()
Dim i As Integer
Dim index As Integer
Dim FactorName As String
Dim Flds() As TypeFieldColumn
ReDim Flds(1 To rsTS.Fields.Count - 1)
For i = 1 To rsTS.Fields.Count - 1
FactorName = rsTS.Fields(i).Name
index = MapBloombergIndexToFactorName(FactorName)
If index > 0 Then FactorName = pMap(index).MapName
Flds(i).iCol = Application.WorksheetFunction.Match(FactorName, wsTS.Range("1:1"), 0)
Next
FindFactorColumns = Flds
End Function
I get a run time error of type mismatch on the line Fields = FindFactorColumns(rsTS, wsTS) - I don't understand why though?
Only writing this up to save #Rory time, it is his answer.
The type mismatch occurred because wsTS, which was saved as a single worksheet in the Populate Worksheet Sub, was declared as multiple worksheets in the FindFactorColumn function.
Because the error line occured at the function call, #Rory was able to determine the type mismatch by looking at the type of the variables used in the Function and comparing them to the type of those same variables when saved in the Sub.