Related
is it possible to pass all elements of an array to a ParamArray?
For example I'd like to pass a ParamArray to another ParamArray:
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys 'should be the same as: p2 "test", "banane", "birne"
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key 'Run-time error '13' Type mismatch (key is an array)
Next key
End Sub
In this case ParamArray of p2 doesn't contain the elements of keys, but it gets the array-object keys. Thus I've got to check, if an arrays is passed:
Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys
End Sub
Sub p2(ParamArray params() As Variant)
Dim keys As Variant
If IsArray(params(0)) Then
keys = params(0)
Else
keys = params
End If
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub
But this is awkward for example compared to Java:
public class VarArgs {
public static void main(String[] args) {
p1("test", "banane", "birne");
p2("test", "banane", "birne");
String[] array = {"test", "banane", "birne"};
p1(array);
p2(array);
}
public static void p1(String... strings) {
p2(strings);
}
public static void p2(String... strings) {
for (String string : strings) {
System.out.println(string);
}
}
}
In Java I don't have to distinguish. But this is probably not possible in VBA.
Thanks for help,
Michael
Pass a ParamArray argument to another function that expects a ParamArray argument (delegate ParamArray arguments).
I need to delegate to a function of type: strf(str as string, ParamArray args() as Variant) as String the arguments received in other function in a ParamArray passing directly without explicitly write.
The restrictions I've found are:
A ParamArray() it can only be passed to another function that expects a ParamArray.
The ParamArray is received at element 0 as a Variant ()
When the second function receives it increases a level of depth
I have not found any satisfactory solution, but I have written a function that works perfectly, undoing the depth levels added and returning a vector with arguments received.
Code:
Option Explicit
Option Base 1
Public Sub PrAr1(ParamArray pa1() As Variant)
Dim arr() As Variant
arr = fn.ParamArrayDelegated(pa1)
PrAr2 pa1
End Sub
Public Sub PrAr2(ParamArray pa2() As Variant)
Dim i As Integer, arrPrms() As Variant
arrPrms = fn.ParamArrayDelegated(pa2)
For i = 0 To UBound(arrPrms)
Debug.Print s.strf("i: %0 prm: %1 ", i, arrPrms(i))
Next i
PrAr3 pa2
End Sub
Public Sub PrAr3(ParamArray pa3() As Variant)
Dim i As Integer, arrPrms() As Variant
arrPrms = fn.ParamArrayDelegated(pa3)
For i = 0 To UBound(arrPrms)
Debug.Print s.strf("i: %0 prm: %1 ", i, arrPrms(i))
Next i
End Sub
Public Function ParamArrayDelegated(ParamArray prms() As Variant) As Variant
Dim arrPrms() As Variant, arrWrk() As Variant
'When prms(0) is Array, supposed is delegated from another function
arrPrms = prms
Do While VarType(arrPrms(0)) >= vbArray And UBound(arrPrms) < 1
arrWrk = arrPrms(0)
arrPrms = arrWrk
Loop
ParamArrayDelegated = arrPrms
End Function
you could convert it into a Variant from the 2nd call on:
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 CVar(keys) '<--| pass it as a Variant
End Sub
Sub p2(keys As Variant) '<--| accept a Variant argument
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub
Here's my solution. Note that Its one restriction is that you can pass only one (Variant) array argument to the ParamArray parameter set. Possibly it could be generalized to handle multiple passed arrays but I have yet to run into that need.
Option Explicit
Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
Dim TempKeys As Variant
TempKeys = keys 'ParamArray isn't actually a standard Variant array, so you have to copy
'it to one in order for the added test/workaround in p2 to not crash
'Excel.
p2 TempKeys 'should be the same as: p2 "test", "banane", "birne"
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
If IsArray(keys(0)) Then keys = keys(0) 'Set this routine's ParamArray parameter to be
'the array of its first element.
For Each key In keys
Debug.Print key
Next key
End Sub
Try:
Sub p2(ParamArray keys() As Variant)
dim myKey as Variant
If IsArray(keys(0)) Then
myKey = keys(0)
Else
myKey = keys()
End If
...
end sub
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key(0) '<- Give an Index here.
Next key
End Sub
One of my strongest needs is to be able to take a ParamArray values() As Variant and turned it into a String().
Per the OPs question, I also need to be able to forward other functions to this function, where the other functions have a ParamArray which needs also to be converted to a String() before that function can continue to process.
Here's the solution which includes a robust function to safely return an Array's size:
Public Function f_uas_astrFromParamArray( _
ParamArray pr_avarValues() As Variant _
) As String()
Dim astrResult() As String
Dim avarTemp() As Variant
Dim lngSize As Long
Dim lngUBound As Long
Dim lngIndex As Long
If (IsMissing(pr_avarValues) = False) Then
If (IsArray(pr_avarValues(0)) = True) Then
avarTemp = pr_avarValues(0)
Else
avarTemp = pr_avarValues
End If
lngSize = f_lngArraySize(avarTemp)
If (lngSize > 0) Then
lngUBound = lngSize - 1
ReDim astrResult(0 To lngUBound)
For lngIndex = 0 To lngUBound
astrResult(lngIndex) = CStr(avarTemp(lngIndex))
Next lngIndex
End If
End If
f_uas_astrFromParamArray = astrResult
End Function
'Return Value:
' -1 - Not an Array
' 0 - Empty
' > 0 - Defined
Public Function f_ua_lngArraySize( _
ByRef pr_avarValues As Variant _
, Optional ByVal pv_lngDimensionOneBased As Long = 1 _
) As Long
Dim lngSize As Long: lngSize = -1 'Default to not an Array
Dim lngLBound As Long
Dim lngUBound As Long
On Error GoTo Recovery
If (IsArray(pr_avarValues) = True) Then
lngSize = 0 'Move default to Empty
lngLBound = LBound(pr_avarValues, pv_lngDimensionOneBased)
lngUBound = UBound(pr_avarValues, pv_lngDimensionOneBased)
If (lngLBound <= lngUBound) Then
lngSize = lngUBound - lngLBound + 1 'Non-Empty, so return size
End If
End If
NormalExit:
f_ua_lngArraySize = lngSize
Exit Function
Recovery:
GoTo NormalExit
End Function
In order to pass a ParamArray Variant from function to function called from Excel itself, the unboxing principle showed in previous posts by #JoséIborraBotia was working for a list of ranges,
but
catching the exception raised when trying to unbox one level to much instead of
testing VarType, UBound or IsArray like proposed previously,
allows it to also work for a single range,
witch is critical when passing Excel selections to a custom function.
Let find this unboxing function along with a demonstration of its use to count any combination of Excel cells selection:
ParamArray unboxing function:
Public Function unboxPA(ParamArray prms() As Variant) As Variant
Dim arrPrms() As Variant, arrWrk() As Variant
Dim done As Boolean
done = False
arrPrms = prms
Do While Not done
On Error Resume Next
arrWrk = arrPrms(0)
If (Err.Number > 0) Then
done = True
End If
arrPrms = arrWrk
Loop
unboxPA = arrPrms
End Function
Unboxing used to count any excel cells selction:
Function MyCountLargeCellsPA(ParamArray rangeArray() As Variant)
Dim unboxed() As Variant
unboxed = unboxPA(rangeArray)
Dim n As Long
For n = LBound(unboxed) To UBound(unboxed)
MyCountLargeCellsPA = MyCountLargeCellsPA + unboxed(n).CountLarge
Next
End Function
This allow any nested call from function to function using ParamArray,
It is now possible to program using VBA !
This will not help the OP anymore since the question has been asked 10 years ago in 2013.
However, if anyone runs into this issue, please do not implement such a horrible stuff blowing up the code logic (and performance) as suggested by most of the answers. Just write clean code to get around that issue.
If you actually want a ParamArray, then do that in the public interface and convert it into an ordinary Array. Let the implementation do the stuff in a straight forward way.
Option Explicit
Public Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
p3 "test", "banane", "birne"
End Sub
'public interface
Public Sub p1(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p1V keys_
End Sub
Public Sub p2(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p2V keys_
End Sub
Public Sub p3(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p3V keys_
End Sub
'private (or even public) implementation
Private Sub p1V(keys() As Variant)
p2V keys
End Sub
Private Sub p2V(keys() As Variant)
p3V keys
End Sub
Private Sub p3V(keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
' "test", "banane", "birne"
' no matter which cascaded function was called
End Sub
paramArrays are weird but you can use normal Array, which works just fine
Sub test()
Dim a As Variant: a = Array("test", "banane", "birne")
p1 a
End Sub
Sub p1(keys As Variant)
p2 keys
End Sub
Sub p2(keys As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub
It gives me an error message when i try to assign the Words array values from the text file. It tells me that words is"ReadOnly"
This is located in the sub "LoadWords"
Module Module1
Const MaxNoWords As Integer = 10000
Const MaxTries As Integer = 6
Sub Main()
Menu()
End Sub
Sub Menu()
Dim words(MaxNoWords) As String
Dim MenuChoice As Char
Console.WriteLine("Hangman v2")
Do
MenuChoice = GetMenuChoice(MenuChoice)
If MenuChoice = "a" Then
LoadWords(words(MaxNoWords))
ElseIf MenuChoice = "b" Then
PlayHangman()
End If
Loop Until MenuChoice = "x"
Console.ReadLine()
End Sub
Function GetMenuChoice(MenuChoice As Char)
Console.WriteLine(" A - Load Words" & vbNewLine & " B - Play" & vbNewLine & " X - Quit")
MenuChoice = Console.ReadLine
Return MenuChoice
End Function
Sub LoadWords(ByRef words As String)
Dim index As Integer = 0
Console.WriteLine("Loading Words")
FileOpen(1, "U:\A Level Computing\words.txt", OpenMode.Input)
Do
words(index) = LineInput(1)
Loop Until EOF(1)
FileClose(1)
Console.ReadLine()
End Sub
Sub PlayHangman()
Console.WriteLine("Playing Hangman DO NOT Disturb")
Console.ReadLine()
End Sub
End Module
You can change your code like this ...
dim mod_words(MaxNoWords) as string
Sub Main()
Menu()
End Sub
Sub Menu()
' removed line
Dim MenuChoice As Char
and later
Do
mod_words(index) = LineInput(1)
Loop Until EOF(1)
Further I would suggest to use FreeFile (get free file handle) into a var, so you are not fixed to "1".
And somehow I do not understand, why yo try to add only at the last item in your array ...
Could you please explain, what exactly you try to achieve?
It looks like you want to load each word from the file (each on its own line) into the array called words.
If so, simply change:
Sub LoadWords(ByRef words As String)
To:
Sub LoadWords(ByRef words() As String)
Notice the addition of parenthesis, which indicates an Array, not a single string, is being passed.
*Also, ByRef is not necessary here, you could change to ByVal.
Explanations and comments in line.
Imports System.IO
Module Module1
Const MaxTries As Integer = 6
'Moved words to Module level so it can be seen from
'all method in the Module
'Changed from array to List(Of String)
'so we don't have to worry about the size
Private words As New List(Of String)
Public Sub Main()
Menu()
End Sub
Sub Menu()
Console.WriteLine("Hangman v2")
Dim MenuChoice As Char
Do
MenuChoice = GetMenuChoice()
'Also check if list is empty - you don't want to keep loading words
If MenuChoice = "a" AndAlso Not words.Any Then
LoadWords()
'Check if the list has word, can't play without words
ElseIf MenuChoice = "b" AndAlso words.Any Then
PlayHangman()
End If
Loop Until MenuChoice = "x"
End Sub
Function GetMenuChoice() As Char
Console.WriteLine(" A - Load Words" & vbNewLine & " B - Play" & vbNewLine & " X - Quit")
Dim MenuChoice = CChar(Console.ReadLine.ToLower)
Return MenuChoice
End Function
Sub LoadWords()
Console.WriteLine("Loading Words")
Dim path = "U:\A Level Computing\words.txt"
'Use the .net IO methods instead of the old vb methods
words = File.ReadAllLines(path).ToList
End Sub
Sub PlayHangman()
Console.WriteLine("Playing Hangman DO NOT Disturb")
Console.ReadLine()
End Sub
End Module
I have created a DLL file in VB.NET and I want use it in Excel VBA. When I use it like a function it is working perfect but when I use sub with a ByRef variable it does not work and Excel restarts with an error.
The code in VB.NET is:
Public Function distinctArr(ByVal arr As String()) As String()
Return arr.ToList.Distinct.ToArray
End Function
Public Sub sortArr(ByVal arr As String(), ByRef a As String())
Dim tolist As List(Of String) = arr.ToList
tolist.Sort()
a = tolist.ToArray
End Sub
This is the code in VBA:
Dim objMda As Excelcode.mda
Set objMda = New Excelcode.mda
Dim distinc_Item() As String
Dim all_Items() As String
all_Items = rng_to_string(rng_rizmetre)
distinc_Item = objMda.distinctArr(all_Items) '''This line is working perfect
Dim Sorted_Item() As String
objMda.sortArr distinc_Item, Sorted_Item
What is wrong with the code?
Finally i can find my answer.
code in vb.net
Public Class MainClass
Sub sortArr(ByVal arr As String(), ByRef sortedarr As String())
sortedarr = arr
Array.Sort(sortedarr)
End Sub
End Class
and code in excel vba:
Sub aaa()
Dim Mycode As excelcode.MainClass
Set Mycode = New excelcode.MainClass
Dim arr(2) As String
arr(0) = "m"
arr(1) = "a"
arr(2) = "d"
Dim sortedArr() As String
ReDim sortedArr(0)
Mycode.sortArr arr, sortedArr
End Sub
by this code i can pass array byval to vb.net dll then vb.net pass sorted array.
I have a worksheet with data in column 'EGM'. My code saves values from this column in the collection.
If there is only one value in the collection, then variable sSelectedEGM is equal to this value.
But if there is more than one values, a user should has possibility to choose only one value (I wanted to do this in the combobox) and save selected item into variable sSelectedEGM.
My problem is, that I can't get values from this collection into userform.
When my code go into useform, the error "Type mismatch" appear. My code in worksheet:
Public sSelectedEGM As String
Public vElement As Variant
Public cEGMList As New VBA.Collection
Sub kolekcjaproba()
' ===================================
' LOOP THROUGH EGMS AND WRITE THEM INTO COLLECTION
' ===================================
Dim iOpenedFileFirstEGMRow As Integer
Dim iOpenedFileLastEGMRow As Integer
Dim iOpenedFileEGMColumn As Integer
Dim iOpenedFileEGMRow As Integer
Dim sOpenedFileEGMName As String
Dim ws As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
iOpenedFileFirstEGMRow = Cells.Find("EGM").Offset(1, 0).Row
iOpenedFileLastEGMRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, iOpenedFileFirstEGMRow).End(xlUp).Row
iOpenedFileEGMColumn = Cells.Find("EGM").Column
For iOpenedFileEGMRow = iOpenedFileFirstEGMRow To iOpenedFileLastEGMRow
sOpenedFileEGMName = Cells(iOpenedFileEGMRow, iOpenedFileEGMColumn).Value
For Each vElement In cEGMList
If vElement = sOpenedFileEGMName Then
GoTo NextEGM
End If
Next vElement
cEGMList.Add sOpenedFileEGMName
NextEGM:
Next
If cEGMList.Count = 1 Then
sSelectedEGM = cEGMList.Item(1)
ElseIf cEGMList.Count = 0 Then
MsgBox "No EGM found"
Else
Load UserForm1
UserForm1.Show
End If
End Sub
And my code in a userform (There is only a combobox on it)
Private Sub UserForm_Initialize()
For Each vElement In cEGMList
UserForm1.ComboBox1.AddItem vElement
Next vElement
End Sub
Private Sub ComboBox1_Change()
If ComboBox1.ListIndex <> -1 Then
sSelectedEGM = ComboBox1.List(ComboBox1.ListIndex)
End If
End Sub
you have to declare cEGMList and sSelectedEGM in a standard module as public and not in a worksheet module.
Or even better: create a property on the form for the collection and for the returned values. It's always better to avoid global vars wherever possible.
This is a simplified example. In the form you can define properties and methods like that:
Option Explicit
Public TestProperty As Integer
Public Sub TestMethod()
MsgBox (TestProperty)
End Sub
Public Function TestMethodWithReturn() As Integer
TestMethodWithReturn = TestProperty * 2
End Function
outside the form you can then use this as a normal property/method of the form:
Private Sub Test()
Dim retValue As Integer
UserForm1.TestProperty = 123
UserForm1.Show vbModeless
UserForm1.TestMethod
retValue = UserForm1.TestMethodWithReturn
Debug.Print retValue
End Sub
is it possible to pass all elements of an array to a ParamArray?
For example I'd like to pass a ParamArray to another ParamArray:
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys 'should be the same as: p2 "test", "banane", "birne"
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key 'Run-time error '13' Type mismatch (key is an array)
Next key
End Sub
In this case ParamArray of p2 doesn't contain the elements of keys, but it gets the array-object keys. Thus I've got to check, if an arrays is passed:
Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys
End Sub
Sub p2(ParamArray params() As Variant)
Dim keys As Variant
If IsArray(params(0)) Then
keys = params(0)
Else
keys = params
End If
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub
But this is awkward for example compared to Java:
public class VarArgs {
public static void main(String[] args) {
p1("test", "banane", "birne");
p2("test", "banane", "birne");
String[] array = {"test", "banane", "birne"};
p1(array);
p2(array);
}
public static void p1(String... strings) {
p2(strings);
}
public static void p2(String... strings) {
for (String string : strings) {
System.out.println(string);
}
}
}
In Java I don't have to distinguish. But this is probably not possible in VBA.
Thanks for help,
Michael
Pass a ParamArray argument to another function that expects a ParamArray argument (delegate ParamArray arguments).
I need to delegate to a function of type: strf(str as string, ParamArray args() as Variant) as String the arguments received in other function in a ParamArray passing directly without explicitly write.
The restrictions I've found are:
A ParamArray() it can only be passed to another function that expects a ParamArray.
The ParamArray is received at element 0 as a Variant ()
When the second function receives it increases a level of depth
I have not found any satisfactory solution, but I have written a function that works perfectly, undoing the depth levels added and returning a vector with arguments received.
Code:
Option Explicit
Option Base 1
Public Sub PrAr1(ParamArray pa1() As Variant)
Dim arr() As Variant
arr = fn.ParamArrayDelegated(pa1)
PrAr2 pa1
End Sub
Public Sub PrAr2(ParamArray pa2() As Variant)
Dim i As Integer, arrPrms() As Variant
arrPrms = fn.ParamArrayDelegated(pa2)
For i = 0 To UBound(arrPrms)
Debug.Print s.strf("i: %0 prm: %1 ", i, arrPrms(i))
Next i
PrAr3 pa2
End Sub
Public Sub PrAr3(ParamArray pa3() As Variant)
Dim i As Integer, arrPrms() As Variant
arrPrms = fn.ParamArrayDelegated(pa3)
For i = 0 To UBound(arrPrms)
Debug.Print s.strf("i: %0 prm: %1 ", i, arrPrms(i))
Next i
End Sub
Public Function ParamArrayDelegated(ParamArray prms() As Variant) As Variant
Dim arrPrms() As Variant, arrWrk() As Variant
'When prms(0) is Array, supposed is delegated from another function
arrPrms = prms
Do While VarType(arrPrms(0)) >= vbArray And UBound(arrPrms) < 1
arrWrk = arrPrms(0)
arrPrms = arrWrk
Loop
ParamArrayDelegated = arrPrms
End Function
you could convert it into a Variant from the 2nd call on:
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 CVar(keys) '<--| pass it as a Variant
End Sub
Sub p2(keys As Variant) '<--| accept a Variant argument
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub
Here's my solution. Note that Its one restriction is that you can pass only one (Variant) array argument to the ParamArray parameter set. Possibly it could be generalized to handle multiple passed arrays but I have yet to run into that need.
Option Explicit
Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
Dim TempKeys As Variant
TempKeys = keys 'ParamArray isn't actually a standard Variant array, so you have to copy
'it to one in order for the added test/workaround in p2 to not crash
'Excel.
p2 TempKeys 'should be the same as: p2 "test", "banane", "birne"
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
If IsArray(keys(0)) Then keys = keys(0) 'Set this routine's ParamArray parameter to be
'the array of its first element.
For Each key In keys
Debug.Print key
Next key
End Sub
Try:
Sub p2(ParamArray keys() As Variant)
dim myKey as Variant
If IsArray(keys(0)) Then
myKey = keys(0)
Else
myKey = keys()
End If
...
end sub
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key(0) '<- Give an Index here.
Next key
End Sub
One of my strongest needs is to be able to take a ParamArray values() As Variant and turned it into a String().
Per the OPs question, I also need to be able to forward other functions to this function, where the other functions have a ParamArray which needs also to be converted to a String() before that function can continue to process.
Here's the solution which includes a robust function to safely return an Array's size:
Public Function f_uas_astrFromParamArray( _
ParamArray pr_avarValues() As Variant _
) As String()
Dim astrResult() As String
Dim avarTemp() As Variant
Dim lngSize As Long
Dim lngUBound As Long
Dim lngIndex As Long
If (IsMissing(pr_avarValues) = False) Then
If (IsArray(pr_avarValues(0)) = True) Then
avarTemp = pr_avarValues(0)
Else
avarTemp = pr_avarValues
End If
lngSize = f_lngArraySize(avarTemp)
If (lngSize > 0) Then
lngUBound = lngSize - 1
ReDim astrResult(0 To lngUBound)
For lngIndex = 0 To lngUBound
astrResult(lngIndex) = CStr(avarTemp(lngIndex))
Next lngIndex
End If
End If
f_uas_astrFromParamArray = astrResult
End Function
'Return Value:
' -1 - Not an Array
' 0 - Empty
' > 0 - Defined
Public Function f_ua_lngArraySize( _
ByRef pr_avarValues As Variant _
, Optional ByVal pv_lngDimensionOneBased As Long = 1 _
) As Long
Dim lngSize As Long: lngSize = -1 'Default to not an Array
Dim lngLBound As Long
Dim lngUBound As Long
On Error GoTo Recovery
If (IsArray(pr_avarValues) = True) Then
lngSize = 0 'Move default to Empty
lngLBound = LBound(pr_avarValues, pv_lngDimensionOneBased)
lngUBound = UBound(pr_avarValues, pv_lngDimensionOneBased)
If (lngLBound <= lngUBound) Then
lngSize = lngUBound - lngLBound + 1 'Non-Empty, so return size
End If
End If
NormalExit:
f_ua_lngArraySize = lngSize
Exit Function
Recovery:
GoTo NormalExit
End Function
In order to pass a ParamArray Variant from function to function called from Excel itself, the unboxing principle showed in previous posts by #JoséIborraBotia was working for a list of ranges,
but
catching the exception raised when trying to unbox one level to much instead of
testing VarType, UBound or IsArray like proposed previously,
allows it to also work for a single range,
witch is critical when passing Excel selections to a custom function.
Let find this unboxing function along with a demonstration of its use to count any combination of Excel cells selection:
ParamArray unboxing function:
Public Function unboxPA(ParamArray prms() As Variant) As Variant
Dim arrPrms() As Variant, arrWrk() As Variant
Dim done As Boolean
done = False
arrPrms = prms
Do While Not done
On Error Resume Next
arrWrk = arrPrms(0)
If (Err.Number > 0) Then
done = True
End If
arrPrms = arrWrk
Loop
unboxPA = arrPrms
End Function
Unboxing used to count any excel cells selction:
Function MyCountLargeCellsPA(ParamArray rangeArray() As Variant)
Dim unboxed() As Variant
unboxed = unboxPA(rangeArray)
Dim n As Long
For n = LBound(unboxed) To UBound(unboxed)
MyCountLargeCellsPA = MyCountLargeCellsPA + unboxed(n).CountLarge
Next
End Function
This allow any nested call from function to function using ParamArray,
It is now possible to program using VBA !
This will not help the OP anymore since the question has been asked 10 years ago in 2013.
However, if anyone runs into this issue, please do not implement such a horrible stuff blowing up the code logic (and performance) as suggested by most of the answers. Just write clean code to get around that issue.
If you actually want a ParamArray, then do that in the public interface and convert it into an ordinary Array. Let the implementation do the stuff in a straight forward way.
Option Explicit
Public Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
p3 "test", "banane", "birne"
End Sub
'public interface
Public Sub p1(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p1V keys_
End Sub
Public Sub p2(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p2V keys_
End Sub
Public Sub p3(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p3V keys_
End Sub
'private (or even public) implementation
Private Sub p1V(keys() As Variant)
p2V keys
End Sub
Private Sub p2V(keys() As Variant)
p3V keys
End Sub
Private Sub p3V(keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
' "test", "banane", "birne"
' no matter which cascaded function was called
End Sub
paramArrays are weird but you can use normal Array, which works just fine
Sub test()
Dim a As Variant: a = Array("test", "banane", "birne")
p1 a
End Sub
Sub p1(keys As Variant)
p2 keys
End Sub
Sub p2(keys As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub