I have a module that stores an array of Range objects that is called in other modules. While this module is functional, it's sloppy, and I would like the code to be easy to read/edit for future developers. Ideally this would not only be easy to read/edit but also be a range array (as opposed to variant array).
How the module is called(ideally would be 'As Range'):
Sub CallModule()
'...
Dim rangeArray As Variant
'...
rangeArray = RngArr()
'...
Call AnotherModule(rangeArray(count))
End Sub
Current Module:
Public Function RngArr() As Variant
RngArr = Array(Range("'ActivityTracker'!B12"), Range("'ActivityTracker'!H12"), Range("'ActivityTracker'!B26"), Range("'ActivityTracker'!H26"), Range("'ActivityTracker'!B39"), Range("'ActivityTracker'!H39"), Range("'ActivityTracker'!B53"))
End Function
I am getting a couple of errors when I attempt to put it together,
Returns 'expected array':
Public Function RngArr() As Range
ReDim RngArr(0 To 6) '<---Expected Array
Set RngArr(0) = Range("'ActivityTracker'!B12")
Set RngArr(1) = Range("'ActivityTracker'!H12")
Set RngArr(2) = Range("'ActivityTracker'!B26")
Set RngArr(3) = Range("'ActivityTracker'!H26")
Set RngArr(4) = Range("'ActivityTracker'!B39")
Set RngArr(5) = Range("'ActivityTracker'!H39")
Set RngArr(6) = Range("'ActivityTracker'!B53")
End Function
Returns 'Invalid ReDim':
Public Function RngArr() As Variant
ReDim RngArr(0 To 6) As Range '<---Invalid ReDim
Set RngArr(0) = Range("'ActivityTracker'!B12")
Set RngArr(1) = Range("'ActivityTracker'!H12")
Set RngArr(2) = Range("'ActivityTracker'!B26")
Set RngArr(3) = Range("'ActivityTracker'!H26")
Set RngArr(4) = Range("'ActivityTracker'!B39")
Set RngArr(5) = Range("'ActivityTracker'!H39")
Set RngArr(6) = Range("'ActivityTracker'!B53")
End Function
I don't know VBA well enough to know exactly what's going on with these errors and I have a number of these modules that need to be fixed. So if someone could give a quick explanation of why I am getting these errors and how to fix them I would really appreciate it!
EDIT: The purpose of this module is to give global access to the locations of various tables in the worksheet so the locations themselves are what matter, not the values in the cells. But this array is used a few times in the workbook because other modules need access to the tables in order to be able to work properly. Also I know you can reference the tables directly but there are many cases in this particular program that would make referencing tables individually much harder than it needs to be.
Public Function RngArr() As Range()
Dim rv(0 To 6) As Range
Set rv(0) = Range("'ActivityTracker'!B12")
Set rv(1) = Range("'ActivityTracker'!H12")
Set rv(2) = Range("'ActivityTracker'!B26")
Set rv(3) = Range("'ActivityTracker'!H26")
Set rv(4) = Range("'ActivityTracker'!B39")
Set rv(5) = Range("'ActivityTracker'!H39")
Set rv(6) = Range("'ActivityTracker'!B53")
RngArr = rv
End Function
Sub Tester()
Debug.Print RngArr()(2).Address()
End Sub
It's not clear what you're trying to do here.
The following code works though:
Public Function testArr() As Variant
Dim newArr() As Range
ReDim newArr(1 To 5) As Range
Set newArr(1) = Sheets("Sheet1").Range("A1")
testArr = newArr
End Function
Public Sub test()
Dim myArr As Variant
myArr = testArr()
End Sub
myArr is still going to be a variant when it gets returned, not a range array if you do it this way, but this seems to match your intent.
Related
Context: I am writing a function which returns words/numbers present in a string which are enclosed by parenthesis.
Example: Calling ExtractParenthesis("This {should} work. But {doesnt}.") should return a collection containing two items, should and doesnt.
Error: The error I receive from the code below is
Run-time error '450': Wrong number of arguments or invalid property
assignment
It doesn't appear on a particular line and I just receive an error message with "OK" and "Help" as options.
Code:
Public Function ExtractParenthesis(strText As String) As Collection
Dim i As Long
Dim RegExp As Object
Dim Matches As Object
Dim Output As New Collection
Set Output = Nothing
Set RegExp = CreateObject("vbscript.regexp")
RegExp.Pattern = "{(.*?)}"
RegExp.Global = True
Set Matches = RegExp.Execute(strText)
For i = 0 To (Matches.count - 1)
Output.Add Matches(i).submatches(0)
Next i
Set ExtractParenthesis = Output
End Function
It works exactly the way you want it for me:
Option Explicit
Public Sub TestMe()
Dim myColl As New Collection
Set myColl = ExtractParenthesis("This {should} work. But {doesnt}.")
Debug.Print myColl(1)
Debug.Print myColl(2)
End Sub
Public Function ExtractParenthesis(strText As String) As Collection
Dim i As Long
Dim RegExp As Object
Dim Matches As Object
Dim Output As New Collection
Set Output = Nothing
Set RegExp = CreateObject("vbscript.regexp")
RegExp.Pattern = "{(.*?)}"
RegExp.Global = True
Set Matches = RegExp.Execute(strText)
For i = 0 To (Matches.Count - 1)
Output.Add Matches(i).submatches(0)
Next i
Set ExtractParenthesis = Output
End Function
I receive "should" and "doesnt" on the immediate window (Ctrl+G). Probably you are not aware that you are returning a collection. It should be used with the Set keyword.
To run it from the immediate window, try like this:
?ExtractParenthesis("This {should} work. But {doesnt}.")(1)
?ExtractParenthesis("This {should} work. But {doesnt}.")(2)
From what I understand of your comment to Vityatas answer you mean you want to run it as a worksheet function - running it directly
The changes I've made to your code will let you use it as a function:
In A1:B1 this will work: {=ExtractParenthesis("This {should} work. But {doesnt}.")}
In A1:A2 use it like this: {=TRANSPOSE(ExtractParenthesis("This {should} work. But {doesnt}."))}
NB: The curly brackets are added by Excel when you enter the formula using Ctrl+Shift+Enter rather than Enter on its own.
The one problem with the code is that you must select the correct number of cells first - if it should return three words, but you've only selected two then you'll only see the first two.
Public Function ExtractParenthesis(strText As String) As Variant
Dim i As Long
Dim RegExp As Object
Dim Matches As Object
Dim Output As Variant
Set Output = Nothing
Set RegExp = CreateObject("vbscript.regexp")
RegExp.Pattern = "{(.*?)}"
RegExp.Global = True
Set Matches = RegExp.Execute(strText)
ReDim Output(1 To Matches.Count)
For i = 1 To (Matches.Count)
Output(i) = Matches(i - 1).submatches(0)
Next i
ExtractParenthesis = Output
End Function
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 an excel sheet with values in a range which I want to perform some calculations on in vb.net. I pass that range to vb.net using COM. When I try editing the values of the range, nothing happens.
My question seems to be very similar to these questions, but I can't quite figure out what step I am missing.
How to edit cell value in VB.net - Using .Interop.Excel
VB.net Office Solution - Accessing value in named Range in a Worksheet
VBA CODE:
Function MyTestRange (Byref myrng as range)
Set classLib = New VBProject.CClass
MyTestRange = classLib.MyTestRange(myrng)
End Function
VB.NET code
Imports Microsoft.Office.Interop.Excel
Public Class CClass
Function MyTestRange(ByRef myrng As Range) As Double
Dim newrng As Range
Dim b As Integer = myrng.Rows.Count
Dim i As Integer
newrng = myrng
For i = 1 To b
newrng.Value2(i, 1) = myrng.Value2(i, 1) + 1
Next i
MyTestRange = newrng.Value2(1, 1)
End Function
End class
While this code doesn't generate an error, it doesn't change the values in newrng.
Edit:
I have tried many iterations based on the link provide, but always get the same error :
An exception of type 'System.Runtime.InteropServices.COMException' occurred in mscorlib.dll but was not handled in user code
Additional information: Exception from HRESULT: 0x800A03EC
This is the simplest way to generate the error:
Dim c As Object
c = myrng.Value
myrng.Value = c
Hence amending the values to something new, seems out of reach!
Edit 2:
After chatting with user Mat's Mug, I tried to edit a value in a range, purely in VBA.
This sub works perfectly:
Sub rangesub()
Dim example As Range
Set example = Range("A1:A4")
example.Value = Application.Transpose(Array(1, 2, 3, 4))
End Sub
Excel functions also seem able to handle passing ranges:
Function SimpleCopyRange(myrng)
SimpleCopyRange = myrng
End Function
A very simple combination of this code works:
Function EditRange(myrng)
Dim example As Range
Set example = Range("A1:A4")
EditRange = example
End Function
However there is an unspecified error if I try to edit the range:
Function EditRange(myrng)
Dim example As Range
Set example = Range("A1:A4")
example.Value = Application.Transpose(Array(1, 2, 3, 4))
EditRange = example
End Function
The application.transpose part obviously adds a layer of complexity, and can be replaced with example.Value = 8 without any changes in results.
Looking at this question/answer:
Excel VBA: Iterating over range parameter and change cell values
It appears that a UDF can only change the calling cell.
I think therefore this method is impossible.
The workaround is to to rewrite the code to work with an array, assign the range to an array, edit the array and pass it to the new function.
I'm trying to pass an array into a custom class for storage and further use within that object. The class object has the following definition:
' Class Name: MBRMCurves
Implements ICurves
Private m_lInterpDates() As Long
Public Property Get InterpDates() As Long()
InterpDates = m_lInterpDates
End Property
Public Property Let InterpDates(lInterpDates() As Long)
m_lInterpDates = lInterpDates
End Property
The module that calls this code looks like this:
Dim objResult As New MBRMCurves
'Store the forward prices
Dim fx_fwd() As Double
'Store the interpolation dates
Dim int_dates() As Long
'initially there are no people
Dim NumberTenors As Integer
NumberTenors = 0
Dim cell As range
' Create ranges of Dates
Dim range As range
Dim range_topcell As range
' TODO Pri1 Create the Curves Obj
With Worksheets("test")
' Populate the dates of the FWD rates.
Set range_topcell = .range("B5")
Debug.Print range_topcell.Value
Set range = .range(range_topcell, range_topcell.End(xlDown))
Debug.Print range.Count
' Add more columns to the FWD array
ReDim fx_fwd(0 To range.Count - 1, 0 To 3)
ReDim int_dates(0 To range.Count - 1)
' Set the counter
NumberTenors = 0
' Populate the dates of the FWD rates into the first column of the dates array.
For Each cell In range
NumberTenors = NumberTenors + 1
int_dates(NumberTenors - 1) = cell.Value
Next cell
' Add interpolation dates to Curves object
objResult.InterpDates int_dates
The last line in the above code is giving me the compile error: Invalid use of property.
I believe that the syntax of me Let function is correct, but I might be missing a more subtly nuanced oversight.
Can anyone see what I'm doing wrong? I'm working with Excel 2003 and VBA 6.5 on Windows XP.
Any suggestions would be greatly appreciated.
Thanks,
Christos
a property is not a method call and you need to set it equal to your array:
objResult.InterpDates = int_dates
There still might be an issue with the array your passing in but this is a first step.
VBA for Access lacks a simple Max(x,y) function to find the mathematical maximum of two or more values. I'm accustomed to having such a function already in the base API coming from other languages such as perl/php/ruby/python etc.
I know it can be done: IIf(x > y, x,y). Are there any other solutions available?
I'll interpret the question to read:
How does one implement a function in Access that returns the Max/Min of an array of numbers? Here's the code I use (named "iMax" by analogy with IIf, i.e., "Immediate If"/"Immediate Max"):
Public Function iMax(ParamArray p()) As Variant
' Idea from Trevor Best in Usenet MessageID rib5dv45ko62adf2v0d1cot4kiu5t8mbdp#4ax.com
Dim i As Long
Dim v As Variant
v = p(LBound(p))
For i = LBound(p) + 1 To UBound(p)
If v < p(i) Then
v = p(i)
End If
Next
iMax = v
End Function
Public Function iMin(ParamArray p()) As Variant
' Idea from Trevor Best in Usenet MessageID rib5dv45ko62adf2v0d1cot4kiu5t8mbdp#4ax.com
Dim i As Long
Dim v As Variant
v = p(LBound(p))
For i = LBound(p) + 1 To UBound(p)
If v > p(i) Then
v = p(i)
End If
Next
iMin = v
End Function
As to why Access wouldn't implement it, it's not a very common thing to need, seems to me. It's not very "databasy", either. You've already got all the functions you need for finding Max/Min across domain and in sets of rows. It's also not very hard to implement, or to just code as a one-time comparison when you need it.
Maybe the above will help somebody.
Calling Excel VBA Functions from MS Access VBA
If you add a reference to Excel (Tools → References → Microsoft Excel x.xx Object Library) then you can use WorksheetFunction to call most Excel worksheet functions, including MAX (which can also be used on arrays).
Examples:
MsgBox WorksheetFunction.Max(42, 1999, 888)
or,
Dim arr(1 To 3) As Long
arr(1) = 42
arr(2) = 1999
arr(3) = 888
MsgBox WorksheetFunction.Max(arr)
The first call takes a second to respond (actually 1.1sec for me), but subsequent calls are much more reasonable (<0.002sec each for me).
Referring to Excel as an object
If you're using a lot of Excel functions in your procedure, you may be able to improve performance further by using an Application object to refer directly to Excel.
For example, this procedure iterates a set of records, repeatedly using Excel's MAX on a Byte Array to determine the "highest" ASCII character of each record.
Option Compare Text
Option Explicit
'requires reference to "Microsoft Excel x.xx Object Library"
Public excel As New excel.Application
Sub demo_ListMaxChars()
'list the character with the highest ASCII code for each of the first 100 records
Dim rs As Recordset, mx
Set rs = CurrentDb.OpenRecordset("select myField from tblMyTable")
With rs
.MoveFirst
Do
mx = maxChar(!myField)
Debug.Print !myField, mx & "(" & ChrW(mx) & ")" '(Hit CTRL+G to view)
.MoveNext
Loop Until .EOF
.Close
End With
Set rs = Nothing 'always clean up your objects when finished with them!
Set excel = Nothing
End Sub
Function maxChar(st As String)
Dim b() As Byte 'declare Byte Array
ReDim b(1 To Len(st)) 'resize Byte Array
b = StrConv(st, vbFromUnicode) 'convert String to Bytes
maxChar = excel.WorksheetFunction.Max(b) 'find maximum Byte (with Excel function)
End Function
Because they probably thought that you would use DMAX and DMIN or the sql MAX and only working with the database in access?
Im also curious about why.. Its seems like a overkill to have to create a temp-table and add form values to the table and then run a DMAX or MAX-query on the table to get the result...
I've been known to create a small projMax() function just to deal with these. Not that VBA will probably ever be enhanced, but just in case they ever do add a proper Max (and Min) function, it won't conflict with my functions. BTW, the original poster suggests doing IIF... That works, but in my function, I usually throw a couple of Nz()'s to prevent a null from ruining the function.
Both functions have problems with Null. I think this will be better.
Public Function iMin(ParamArray p()) As Variant
Dim vVal As Variant, vMinVal As Variant
vMinVal = Null
For Each vVal In p
If Not IsNull(vVal) And (IsNull(vMinVal) Or (vVal < vMinVal)) Then _
vMinVal = vVal
Next
iMin = vMinVal
End Function
I liked DGM's use of the IIF statement and David's use of the For/Next loop, so I am combining them together.
Because VBA in access does not have a strict type checking, I will be using varients to preserve all numerics, integer and decimal, and re-type the return value.
Kudos to HansUP for catching my parameter verification :)
Comments added to make code more friendlier.
Option Compare Database
Option Base 0
Option Explicit
Function f_var_Min(ParamArray NumericItems()) As Variant
If UBound(NumericItems) = -1 Then Exit Function ' No parameters
Dim vVal As Variant, vNumeric As Variant
vVal = NumericItems(0)
For Each vNumeric In NumericItems
vVal = IIf(vNumeric < vVal, vNumeric, vVal) ' Keep smaller of 2 values
Next
f_var_Min = vVal ' Return final value
End Function
Function f_var_Max(ParamArray NumericItems()) As Variant
If UBound(NumericItems) = -1 Then Exit Function ' No parameters
Dim vVal As Variant, vNumeric As Variant
vVal = NumericItems(0)
For Each vNumeric In NumericItems
vVal = IIf(vNumeric < vVal, vVal, vNumeric) ' Keep larger of 2 values
Next
f_var_Max = vVal ' Return final value
End Function
The only difference between the 2 functions is the order of vVal and vNumeric in the IIF statement.The for each clause uses internal VBA logic to handle the looping and array bounds checking, while "Base 0" starts the array index at 0.
You can call Excel functions in Access VBA:
Global gObjExcel As Excel.Application
Public Sub initXL()
Set gObjExcel = New Excel.Application
End Sub
Public Sub killXL()
gObjExcel.Quit
Set gObjExcel = Nothing
End Sub
Public Function xlMax(a As Double, b As Double) As Double
xlCeiling = gObjExcel.Application.Max(a, b)
End Function
You can do Worksheetfunction.max() or worksheetfunction.min() within Access VBA. Hope this helps.