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.
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 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.
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... :)
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.
Is there anyway to convert a string value to a Range object ? I'm having a function which takes a Range object as a argument and need to pass a single string parameter to it
Thank You
A string with a cell address? if so:
Dim r As Range: Set r = Range("B3")
MsgBox r.ColumnWidth
I don't like this one bit, but if you can't change the function that requires a range, you could create a function that converts a string to a range. You'd want to be sure that the only thing the first function cares about is the Value or Text properties.
Function FuncThatTakesRange(rng As Range)
FuncThatTakesRange = rng.Value
End Function
Function ConvertStringToRange(sInput As String) As Range
Dim ws As Worksheet
Set ws = Workbooks.Add.Sheets(1)
ws.Range("A1").Value = sInput
Set ConvertStringToRange = ws.Range("A1")
Application.OnTime Now + TimeSerial(0, 0, 1), "'CloseWB """ & ws.Parent.Name & """'"
End Function
Sub CloseWb(sWb As String)
On Error Resume Next
Workbooks(sWb).Close False
End Sub
Use in the Immediate Window like
?functhattakesrange(convertstringtorange("Myvalue"))
Here is my solution that involves no need for a new function.
1.Make dynamic string variable first
2.Then finalize it by creating a range object out of this string via a range method: Set dynamicrange= range (dynamicstring)
You can manipulate dynamicstring as you want to, I just kept it simple so that you can see that you can make range out of a string variable.
Sub test()
Dim dynamicrangecopystring As String
Dim dynamicrangecopy As range
dynamicrangecopystring = "B12:Q12"
Set dynamicrangecopy = range(dynamicrangecopystring)
End Sub
Why not change the function argument to a variant and then in the function determine Using VarType etc) if you have been passed a Range and use error handling to check for a string which can be converted to a range or a string that cannot be converted to a range ?
This simple function will convert string arguments into a range object, usable in other excel functions.
Function TXT2RNG(text) As Variant
Set TXT2RNG = Range(text)
End Function
Let's say Sheet1!A1 has the text value "Sheet1!B1" and Sheet1!B1 has the value "1234". The following code will use the range address stored as text in A1 as an input and copy the range B1 to A2:
Sub Tester()
Sheet1.Range(Range("A1")).Copy
Sheet1.Range("A2").PasteSpecial xlPasteAll
End Sub