Can private sub program being in the same module as main after receiving value from main, creates new variable and pass it back to main?
This is what I am trying to do, but I am having some difficulties.
For example, in testSUB below I altered the string. Can I pass extraSTRING and newSTRING back to main? Any examples would be helpful.
Module module1
Sub main()
Dim l As String
Dim I As Long = 1
Dim A As String
testsub(l, A, I)
End Sub
Private Sub testSub(l As String, A As String, I As Long)
Dim extraSTRING As String = "extraTEXT"
Dim newSTRING As String = l & extraSTRING
End Sub
End Module
To return a value you could turn your Sub into a Function:
Private Function testFunction (ByVal arg1 As String) As String
Return arg1 & " and some more text"
End Function
To call the above Function and assign the value returned use this code:
Dim a As String = testFunction("some text")
'Output:
'a = "some text and some more text"
Below is a screenshot of the code with the output:
Alternatively you can use ByRef:
Specifies that an argument is passed in such a way that the called procedure can change the value of a variable underlying the argument in the calling code.
ByRef differs slightly from ByVal:
Specifies that an argument is passed in such a way that the called procedure or property cannot change the value of a variable underlying the argument in the calling code.
Below is some sample code showing you the differences in action:
Module Module1
Sub Main()
Dim a As Integer = 0
Dim b As Integer = 0
Dim c As Integer = 0
testSub(a, b, c)
'Output:
'a = 0
'b = 0
'c = 3
End Sub
Private Sub testSub(arg1 As Integer, ByVal arg2 As Integer, ByRef arg3 As Integer)
arg1 = 1
arg2 = 2
arg3 = 3
End Sub
End Module
By not specifying a modifier in VB.NET (as shown with arg1 above) the compiler by default will use ByVal.
It would be good to note here that although VB.NET uses ByVal by default if not specified, VBA does not and instead by default uses ByRef. Beware of this should you ever port code from one to the other.
Below is a screenshot of the code with the output:
Using your code as an example:
Sub main()
Dim l As String
Dim A As String
Dim I As Long = 1
testSub(l, A, I)
End Sub
To pass the variables l, A and I and have their value changed you would change your method to use the modifier ByRef.
Private Sub testSub(ByRef l As String, ByRef A As String, ByRef I As Long)
l = "TEXT"
A = "extra" & l
I = 100
End Sub
Below is a screenshot of the code with the output:
Related
I am trying to get an effective class constructor that can take parameters. This seems trivial in most programming languages but VBA is very special.
I have the following code in a normal module named Module2:
Public Sub DoTheThing()
Dim this_guy As SetOfGames
Set this_guy = New SetOfGames
Dim that_guy As SetOfGames
Set that_guy = New SetOfGames
MsgBox "First: " & this_guy.games_played & that_guy.games_played
Set this_guy = factory.CreateFromOther(that_guy.games_played, that_guy.extra_games, that_guy.odds, 1)
End Sub
The following in a second normal module named factory:
Public Function CreateFromOther(ByVal other_games_played As Integer, ByVal other_extra_games As Integer, ByVal other_odds As Double, ByVal giraffe_yes As Integer) As SetOfGames
MsgBox "Second: " & other_games_played
Dim setofgames_obj As SetOfGames
Set setofgames_obj = New SetOfGames
MsgBox "Third: " & other_games_played
setofgames_obj.InitiateFromOther ogp = other_games_played, oeg = other_extra_games, g_yes = giraffe_yes
End Function
And the following in a class module named SetOfGames:
Public extra_games As Integer
Public games_played As Integer
Public odds As Double
Function InitiateFromOther(ByVal ogp As Integer, ByVal oeg As Integer, ByVal g_yes As Integer)
MsgBox "Fourth" & ogp
End Function
I call DoTheThing() from an Excel button, which initialized some SetOfGamess and gives the expected number_of_games in the First MSGBOX: 0
CreateFromOther() is called and I get again the right output in MSGBOX second and MSGBOX third: 0
Then I call InitiateFromOther, passing that nice 0 through, but in the first line of the function, I get the MSGBOX Fourth showing it is -1
This is totally misaligned with my intuition and I don't know why I can't keep a variable straight through a function call... I have very little experience with VBA so there is no lower bound on how dumb my problem is. Anyone know what I'm doing wrong?
I want to use global variables in my workbook and in the ThisWorkbook code. I declared the following varaibles
Public position_1 as string
Public position_2 as string
If I want to see the value of those variables I believe they need to be fully qualified so
Debug.Print ThisWorkbook.position_1
Debug.Print ThisWorkbook.position_2
I have written a UDF which I will pass in an integer to represent which variable I am looking for. I will only be passing in a single number and not a full variable name. I am trying to find a way to use this integer to concatenate with "position_" to display the value of the global variable, ThisWorkbook.position_1, ThisWorkbook.position_2, etc.
Function Test_Global_Var(position as Integer)
Dim variable_name As String
variable_name = "position_" & position
Debug.Print ThisWorkbook.variable_name
End Function
So when I call
Test_Global_Var(1)
my immediate window should display the value of
ThisWorkbook.position_1
The code below produces the following debug output
2 values defined.
ThisWorkbook.Position(0)
First Value
ThisWorkbook.Position(1)
Second Value
It uses a private array in the workbook named m_position. The contents are accessed by a global property ThisWorkbook.Position(index).
In a module have the following code:
Option Explicit
Public Sub Test()
If ThisWorkbook.NoValues Then
ThisWorkbook.FillValues "First Value", "Second Value"
End If
Debug.Print CStr(ThisWorkbook.Count) & " values defined."
Test_Global_Var 0
Test_Global_Var 1
End Sub
Public Sub Test_Global_Var(ByVal index As Long)
' Part of a UDF
Debug.Print "ThisWorkbook.Position(" & CStr(index) & ")"
Debug.Print ThisWorkbook.Position(index)
End Sub
In ThisWorkbook have the following code:
Option Explicit
Private m_position() As Variant
Private Sub Workbook_Open()
Call DefaultValues
End Sub
Public Property Get Position(ByVal index As Long) As Variant
Position = m_position(index)
End Property
Public Sub DefaultValues()
m_position = Array("First", "Second")
End Sub
Public Sub FillValues(ParamArray args() As Variant)
m_position = args
End Sub
Public Property Get Count() As Long
Count = UBound(m_position) - LBound(m_position) + 1
End Property
Public Property Get NoValues() As Boolean
On Error GoTo ArrUndefined:
Dim n As Long
n = UBound(m_position)
NoValues = False
On Error GoTo 0
Exit Sub
ArrUndefined:
NoValues = True
On Error GoTo 0
End Property
PS. In VBA never use Integer, but instead use Long. Integer is a 16bit type, while Long is the standard 32bit type that all other programming languages consider as an integer.
It is possible to consider a global dictionary variable and pass data through it from the UDF.
First add reference to Microsoft Scripting Runtime:
Thus, build the dictionary like this:
Public myDictionary As Dictionary
To initialize the myDictionary variable, consider adding it to a Workbook_Open event:
Private Sub Workbook_Open()
Set myDictionary = New Dictionary
End Sub
Then the UDF would look like this:
Public Function FillDicitonary(myVal As Long) As String
If myDictionary.Exists(myVal) Then
myDictionary(myVal) = "position " & myVal
Else
myDictionary.Add myVal, "position " & myVal
End If
FillDicitonary = "Filled with " & myVal
End Function
And it would overwrite every key in the dictionary, if it exists. At the end, the values could be printed:
Public Sub PrintDictionary()
Dim myKey As Variant
For Each myKey In myDictionary
Debug.Print myDictionary(myKey)
Next
End Sub
I'm looking at a file that someone in my work created, it has the below:
Sub Inputs(zDOB As Date, zRetAge As Double, zRetDate As Date, zDOJ As Date, zEmployer As Double, zEmployee As Double, _
zSalary() As Double, zInflation As Double, zFund As Double, zAVCRate As Double, zEvalDate As Date, zAVCFund As Double, _
zCharge As Double, zFund2 As Double, zAVCFund2 As Double)
zDOB = Range("B1")
zRetAge = Range("B7")
zRetDate = Range("B8")
zDOJ = Range("B11")
zEmployer = Range("B15")
zEmployee = Range("B16")
zSalary(0) = Range("B14")
zInflation = Range("B19")
zFund = Range("B20")
zFund2 = Range("B20")
zAVCRate = Range("B24")
zAVCFund = Range("B27")
zAVCFund2 = Range("B27")
zEvalDate = Range("B6")
zCharge = Range("J7")
End Sub
Fair enough, this is setting up the inputs to be used later.
My problem is when this sub is called again:
Call Module3.Inputs(xDOfB, xRetirementAge, xDateRetire, xDOJ, xEmployer, xEmployee, xSalary, _
xInflation, xFund, xAVC, xEvalDate, xAVCFund, xCharge, xFund2, xAVCFund2)
The z is now x, does this make a difference? How does this work?
You may want to use public variables if you will use them across subscripts.
Public zDOB As Variant
Public zRetAte As Variant
Sub textSub()
Call Inputs
End Sub
Sub Inputs()
zDOB = Range("B1")
zRetAge = Range("B7")
End Sub
When you call a Function/Sub in VBA, you can pass values to it, normally referred to as arguments. The names of arguments and their types are defined in the routine's signature like you have here:
Sub Inputs(zDOB As Date, zRetAge As Double, zRetDate As Date, ...)
To call a routine with certain arguments, you can pass them from the calling code as raw values:
Inputs 1, 2, 4 ... 'equiv to the obsolete Call Inputs(1, 2, 4 ...)
OR, the values you supply when you call a routine can be stored in variables. So I can have a variable being passed as an argument:
Dim x as Date 'here I 'declare' x, you don't generally have to do this but it's advised
x = CDate(Range("A1")) 'here I assign a Value (the date in A1) to a variable (x)
Inputs x, 3, 4, ... 'and call Inputs passing a variable (x) and some values(3,4) as argments
or equivalently for your code:
Dim xDOfB, xRetirementAge, xDateRetire ...
'xDofB = blah 'we could initialise values here
'xRetirementAge = foo
Inputs xDOfB, xRetirementAge, xDateRetire, ... 'call a function with these variables as arguments
So xFoo and zFoo are just variables held by different procedures, the calling code and the Inputs routine respectively
Now what's weird is what the Inputs routine actually does. It takes a load of arguments, which normally would contain values you want to use in the routine. However they are all immediately overwritten. It's a bit like the following:
Option Explicit
Sub Test()
Dim x As Long
x = 5
Debug.Print x 'prints 5; the value initially stored in x
Foo x 'call Foo, passing the variable x which contains the value 5
Debug.Print x 'Actually prints 2! (see below)
End Sub
Sub Foo(arg1 As Long)
arg1 = 2
Debug.Print arg1 'prints 2, the 5 we passed is gone
End Sub
Why would you ever want to do that?
I suspect 2 possible reasons:
The routine declares a load of arguments, when the intention was actually just to declare a load of variables, in which case the code should in fact be:
Sub Inputs()
Dim zDOB As Date
Dim zRetAge As Double
Dim zRetDate As Date
...
zDOB = Range("B1")
zRetAge = Range("B7")
zRetDate = Range("B8")
...
End Sub
And can be called without any xBlah variables passed
The routine is exploiting the default ByRef passing of arguments, and is in fact designed to overwrite all those variables in place (the reason why x is assigned 2 even though it is declared outside the function)
In that case the signature should be made explicit:
Sub Inputs(ByRef zDOB As Date, ByRef zRetAge As Double, ByRef zRetDate As Date ...)
I'm trying to figure this out and can't.
I keep getting an error: "Compile error - Argument not optional". I am supplying the arguments and they are set as Optional!
Trying to pass a string and an array to a function and count occurrences of the array strings within the string passed.
Code stops running at the line:
Public Function countTextInText(Optional text As String, Optional toCountARR As Variant) As Integer
with a "Compile error: Argument not optional" message highlighting the Val in the line:
For Each Val In toCountARR
Full code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nameR As Range
Dim colR As Range
Dim TKRcnt As Integer
Dim TKRarr() As Variant
TKRarr = Array("TKR", "THR", "Bipolar")
Dim ORIFcnt As Integer
Dim ORIFarr() As Variant
TKRarr = Array("ORIF", "Ilizarov", "PFN")
Set nameR = Range("P2:P9")
Set colR = Range("B2:B50,G2:G50,L2:L50")
For Each namecell In nameR
For Each entrycell In colR
If entrycell.text = namecell.text Then
TKRcnt = countTextInText(entrycell.Offset(0, 2).text, TKRarr)
ORIFcnt = countTextInText(entrycell.Offset(0, 2).text, TKRarr)
End If
Next entrycell
MsgBox (namecell.text & " TKR count: " & TKRcnt & " ORIF count: " & ORIFcnt)
Next namecell
End Sub
Public Function countTextInText(Optional text As String, Optional toCountARR As Variant) As Integer
Dim cnt As Integer
Dim inStrLoc As Integer
For Each Val In toCountARR
inStrLoc = InStr(1, text, Val)
While inStrLoc <> 0
inStrLoc = InStr(inStrLoc, text, Val)
cnt = cnt + 1
Wend
Next Val
Set countTextInText = cnt
End Function
Val is a VBA function which requires a single, mandatory, argument - therefore the compiler generates the message saying "Argument not optional" if you don't provide that argument. (MSDN documentation of Val)
It is a bad idea to use VBA function names as variable names, so I would recommend you don't use Val as a variable name - use myVal or anything else that VBA hasn't already used.
If you really want to use Val (and you are sure that you won't be needing to access the Val function at all), you can use it as a variable name if you simply declare it as such, e.g.
Dim Val As Variant
You will also have problems with your line saying
Set countTextInText = cnt
as countTextInText has been declared to be an Integer, and Set should only be used when setting a variable to be a reference to an object. So that line should be
countTextInText = cnt
For those coming late to this question because of the question's title, as I did, having received this error while using the .Find method -
In my case, the problem was that the variable I was Seting was not Dimd at top of function.
My Example
Sub MyTest()
Dim tst, rngAll
rngAll = [a1].CurrentRegion
tst = fnFix1Plus1InValues(ByVal rngAll As Range)
End Sub
Public Function fnFix1Plus1InValues(ByVal rngAll As Range) As Boolean
Dim t1, t2, arr, Loc '<=== Needed Loc added here
Set Loc = rngAll.Find(What:="+", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not Loc Is Nothing Then
Do Until Loc Is Nothing
t1 = Loc.Value
If fnContains(t1, "+") Then
'Do my stuff
End If
Set Loc = rngAll.FindNext(Loc)
Loop
End If
End Function 'fnFix1Plus1InValues
This question already has answers here:
How to find the number of dimensions that an array has?
(3 answers)
Closed 2 years ago.
Does anyone know how to return the number of dimensions of a (Variant) variable passed to it in VBA?
Function getDimension(var As Variant) As Long
On Error GoTo Err
Dim i As Long
Dim tmp As Long
i = 0
Do While True
i = i + 1
tmp = UBound(var, i)
Loop
Err:
getDimension = i - 1
End Function
That's the only way I could come up with. Not pretty….
Looking at MSDN, they basically did the same.
To return the number of dimensions without swallowing errors:
#If VBA7 Then
Private Type Pointer: Value As LongPtr: End Type
Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef src As Any, ByVal Size As LongPtr)
#Else
Private Type Pointer: Value As Long: End Type
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByRef dest As Any, ByRef src As Any, ByVal Size As Long)
#End If
Private Type TtagVARIANT
vt As Integer
r1 As Integer
r2 As Integer
r3 As Integer
sa As Pointer
End Type
Public Function GetDims(source As Variant) As Integer
Dim va As TtagVARIANT
RtlMoveMemory va, source, LenB(va) ' read tagVARIANT '
If va.vt And &H2000 Then Else Exit Function ' exit if not an array '
If va.vt And &H4000 Then RtlMoveMemory va.sa, ByVal va.sa.Value, LenB(va.sa) ' read by reference '
If va.sa.Value Then RtlMoveMemory GetDims, ByVal va.sa.Value, 2 ' read cDims from tagSAFEARRAY '
End Function
Usage:
Sub Examples()
Dim list1
Debug.Print GetDims(list1) ' >> 0 '
list1 = Array(1, 2, 3, 4)
Debug.Print GetDims(list1) ' >> 1 '
Dim list2()
Debug.Print GetDims(list2) ' >> 0 '
ReDim list2(2)
Debug.Print GetDims(list2) ' >> 1 '
ReDim list2(2, 2)
Debug.Print GetDims(list2) ' >> 2 '
Dim list3(0 To 0, 0 To 0, 0 To 0)
Debug.Print GetDims(list3) ' >> 3 '
End Sub
#cularis and #Issun have perfectly adequate answers for the exact question asked. I'm going to question your question, though. Do you really have a bunch of arrays of unknown dimension count floating around? If you're working in Excel, the only situation where this should occur is a UDF where you might get passed either a 1-D array or a 2-D array (or a non-array), but nothing else.
You should almost never have a routine that expects something arbitrary though. And thus you probably shouldn't have a general "find # of array dimensions" routine either.
So, with that in mind, here is the routines I use:
Global Const ERR_VBA_NONE& = 0
Global Const ERR_VBA_SUBSCRIPT_OUT_OF_RANGE& = 9
'Tests an array to see if it extends to a given dimension
Public Function arrHasDim(arr, dimNum As Long) As Boolean
Debug.Assert IsArray(arr)
Debug.Assert dimNum > 0
'Note that it is possible for a VBA array to have no dimensions (i.e.
''LBound' raises an error even on the first dimension). This happens
'with "unallocated" (borrowing Chip Pearson's terminology; see
'http://www.cpearson.com/excel/VBAArrays.htm) dynamic arrays -
'essentially arrays that have been declared with 'Dim arr()' but never
'sized with 'ReDim', or arrays that have been deallocated with 'Erase'.
On Error Resume Next
Dim lb As Long
lb = LBound(arr, dimNum)
'No error (0) - array has given dimension
'Subscript out of range (9) - array doesn't have given dimension
arrHasDim = (Err.Number = ERR_VBA_NONE)
Debug.Assert (Err.Number = ERR_VBA_NONE Or Err.Number = ERR_VBA_SUBSCRIPT_OUT_OF_RANGE)
On Error GoTo 0
End Function
'"vect" = array of one and only one dimension
Public Function isVect(arg) As Boolean
If IsObject(arg) Then
Exit Function
End If
If Not IsArray(arg) Then
Exit Function
End If
If arrHasDim(arg, 1) Then
isVect = Not arrHasDim(arg, 2)
End If
End Function
'"mat" = array of two and only two dimensions
Public Function isMat(arg) As Boolean
If IsObject(arg) Then
Exit Function
End If
If Not IsArray(arg) Then
Exit Function
End If
If arrHasDim(arg, 2) Then
isMat = Not arrHasDim(arg, 3)
End If
End Function
Note the link to Chip Pearson's excellent web site: http://www.cpearson.com/excel/VBAArrays.htm
Also see: How do I determine if an array is initialized in VB6?. I personally don't like the undocumented behavior it relies on, and performance is rarely that important in the Excel VBA code I'm writing, but it's interesting nonetheless.
For arrays, MS has a nice method that involves looping through until an error occurs.
"This routine tests the array named Xarray by testing the LBound of each dimension. Using a For...Next loop, the routine cycles through the number of possible array dimensions, up to 60000, until an error is generated. Then the error handler takes the counter step that the loop failed on, subtracts one (because the previous one was the last one without an error), and displays the result in a message box...."
http://support.microsoft.com/kb/152288
Cleaned-up version of code (decided to write as a function, not sub):
Function NumberOfDimensions(ByVal vArray As Variant) As Long
Dim dimnum As Long
On Error GoTo FinalDimension
For dimnum = 1 To 60000
ErrorCheck = LBound(vArray, dimnum)
Next
FinalDimension:
NumberOfDimensions = dimnum - 1
End Function
Microsoft has documented the structure of VARIANT and SAFEARRAY, and using those you can parse the binary data to get the dimensions.
Create a normal code module. I call mine "mdlDims". You would use it by calling the simple function 'GetDims' and passing it an array.
Option Compare Database
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (var() As Any) As Long
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms221482(v=vs.85).aspx
Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
End Type
'Variants are all 16 bytes, but they are split up differently based on the contained type
'VBA doesn't have the ability to Union, so a Type is limited to representing one layout
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms221627(v=vs.85).aspx
Private Type ARRAY_VARIANT
vt As Integer
wReserved1 As Integer
wReserved2 As Integer
wReserved3 As Integer
lpSAFEARRAY As Long
data(4) As Byte
End Type
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms221170(v=vs.85).aspx
Private Enum VARENUM
VT_EMPTY = &H0
VT_NULL
VT_I2
VT_I4
VT_R4
VT_R8
VT_CY
VT_DATE
VT_BSTR
VT_DISPATCH
VT_ERROR
VT_BOOL
VT_VARIANT
VT_UNKNOWN
VT_DECIMAL
VT_I1 = &H10
VT_UI1
VT_UI2
VT_I8
VT_UI8
VT_INT
VT_VOID
VT_HRESULT
VT_PTR
VT_SAFEARRAY
VT_CARRAY
VT_USERDEFINED
VT_LPSTR
VT_LPWSTR
VT_RECORD = &H24
VT_INT_PTR
VT_UINT_PTR
VT_ARRAY = &H2000
VT_BYREF = &H4000
End Enum
Public Function GetDims(VarSafeArray As Variant) As Integer
Dim varArray As ARRAY_VARIANT
Dim lpSAFEARRAY As Long
Dim sArr As SAFEARRAY
'Inspect the Variant
CopyMemory VarPtr(varArray.vt), VarPtr(VarSafeArray), 16&
'If the Variant is pointing to an array...
If varArray.vt And (VARENUM.VT_ARRAY Or VARENUM.VT_BYREF) Then
'Get the pointer to the SAFEARRAY from the Variant
CopyMemory VarPtr(lpSAFEARRAY), varArray.lpSAFEARRAY, 4&
'If the pointer is not Null
If Not lpSAFEARRAY = 0 Then
'Read the array dimensions from the SAFEARRAY
CopyMemory VarPtr(sArr), lpSAFEARRAY, LenB(sArr)
'and return them
GetDims = sArr.cDims
Else
'The array is uninitialized
GetDims = 0
End If
Else
'Not an array, you could choose to raise an error here
GetDims = 0
End If
End Function
I presume you mean without using On Error Resume Next which most programmers dislike and which also means that during debugging you can't use 'Break On All Errors' to get the code to stop dead (Tools->Options->General->Error Trapping->Break on All Errors).
For me one solution is to bury any On Error Resume Next into a compiled DLL, in the old days this would have been VB6. Today you could use VB.NET but I choose to use C#.
If Visual Studio is available to you then here is some source. It will return a dictionary, the Dicitionary.Count will return the number of dimensions. The items will also contain the LBound and UBound as a concatenated string. I'm always querying an array not just for its dimensions but also for LBound and UBound of those dimensions so I put these together and return a whole bundle of info in a Scripting Dictionary
Here is C# source, start a Class Library calling it BuryVBAErrorsCS, set ComVisible(true) add a reference to COM library 'Microsoft Scripting Runtime', Register for Interop.
using Microsoft.VisualBasic;
using System;
using System.Runtime.InteropServices;
namespace BuryVBAErrorsCS
{
// Requires adding a reference to COM library Microsoft Scripting Runtime
// In AssemblyInfo.cs set ComVisible(true);
// In Build tab check 'Register for Interop'
public interface IDimensionsAndBounds
{
Scripting.Dictionary DimsAndBounds(Object v);
}
[ClassInterface(ClassInterfaceType.None)]
[ComDefaultInterface(typeof(IDimensionsAndBounds))]
public class CDimensionsAndBounds : IDimensionsAndBounds
{
public Scripting.Dictionary DimsAndBounds(Object v)
{
Scripting.Dictionary dicDimsAndBounds;
dicDimsAndBounds = new Scripting.Dictionary();
try
{
for (Int32 lDimensionLoop = 1; lDimensionLoop < 30; lDimensionLoop++)
{
long vLBound = Information.LBound((Array)v, lDimensionLoop);
long vUBound = Information.UBound((Array)v, lDimensionLoop);
string concat = (string)vLBound.ToString() + " " + (string)vUBound.ToString();
dicDimsAndBounds.Add(lDimensionLoop, concat);
}
}
catch (Exception)
{
}
return dicDimsAndBounds;
}
}
}
For Excel client VBA code here is some source
Sub TestCDimensionsAndBounds()
'* requires Tools->References->BuryVBAErrorsCS.tlb
Dim rng As Excel.Range
Set rng = ThisWorkbook.Worksheets.Item(1).Range("B4:c7")
Dim v As Variant
v = rng.Value2
Dim o As BuryVBAErrorsCS.CDimensionsAndBounds
Set o = New BuryVBAErrorsCS.CDimensionsAndBounds
Dim dic As Scripting.Dictionary
Set dic = o.DimsAndBounds(v)
Debug.Assert dic.Items()(0) = "1 4"
Debug.Assert dic.Items()(1) = "1 2"
Dim s(1 To 2, 2 To 3, 3 To 4, 4 To 5, 5 To 6)
Set dic = o.DimsAndBounds(s)
Debug.Assert dic.Items()(0) = "1 2"
Debug.Assert dic.Items()(1) = "2 3"
Debug.Assert dic.Items()(2) = "3 4"
Debug.Assert dic.Items()(3) = "4 5"
Debug.Assert dic.Items()(4) = "5 6"
Stop
End Sub
NOTE WELL: This answer handles grid variants pulled off a worksheet with Range.Value as well as arrays created in code using Dim s(1) etc.! Some of the other answers do not do this.
I like to use the fact that with an error, the new variable-value is not charged.
To get the dimension (A_Dim) of an Array (vArray) you can use following code:
On Error Resume Next
A_Dim = -1
Do Until A = "X"
A_Dim = A_Dim + 1
A = "X"
A = UBound(vArray, A_Dim + 1)
Loop
On Error GoTo 0
Function ArrayDimension(ByRef ArrayX As Variant) As Byte
Dim i As Integer, a As String, arDim As Byte
On Error Resume Next
i = 0
Do
a = CStr(ArrayX(0, i))
If Err.Number > 0 Then
arDim = i
On Error GoTo 0
Exit Do
Else
i = i + 1
End If
Loop
If arDim = 0 Then arDim = 1
ArrayDimension = arDim
End Function
I found a pretty simple way to check, probably laden with a bunch of coding faux pas, incorrect lingo, and ill advised techniques but never the less:
Dim i as Long
Dim VarCount as Long
Dim Var as Variant
'generate your variant here
i = 0
VarCount = 0
recheck1:
If IsEmpty(Var(i)) = True Then GoTo VarCalc
i = i + 1
GoTo recheck1
VarCalc:
VarCount= i - 1
Note: VarCount will obviously return a negative number if Var(0) doesn't exist. VarCount is the max reference number for use with Var(i), i is the number of variants you have.
What about just using ubound(var) + 1? That should give you the last element of most of variables (unless it's a custom range, but in that case you should know that info already). The range of a conventional variable (for instance, when using the split function) starts with 0; ubound gives you the last item of the variable. So if you have a variable with 8 elements, for instance, it will go from 0 (lbound) to 7 (ubound), and you can know the quantity of elements just adding ubound(var) + 1. For example:
Public Sub PrintQntElements()
Dim str As String
Dim var As Variant
Dim i As Integer
str = "Element1!Element2!Element3!Element4!Element5!Element6!Element7!Element8"
var = Split(str, "!")
i = UBound(var) + 1
Debug.Print "First element: " & LBound(var)
Debug.Print "Last element: " & UBound(var)
Debug.Print "Quantity of elements: " & i
End Sub
It will print this output to the Inmediate window:
First element: 0
Last element: 7
Quantity of elements: 8
Also, if you are not sure that the first element (lbound) is 0, you can just use:
i = UBound(var) - LBound(var) + 1