Shift array down by one in vba - arrays

I am having some trouble getting a function I have been writing to work properly. I need it to take an array that is sized 1 to x, and transfer it to a new array which is sized 0 to x-1. I would think it would work just like this:
Private Function ShiftDownArray(theArray() As String) As String()
Dim a As Integer
ReDim ShiftDownArray(LBound(theArray) - 1 To UBound(theArray) - 1)
For a = LBound(theArray) To UBound(theArray)
ShiftDownArray(a - 1) = theArray(a)
Next a
End Function
But I get a compile error: Function call on left-hand side of assignment must return Variant or Object. The documentation on this error essentially says delete that line to make it work, which doesn't point me in the right direction. I have tried changing the type to variant, but it starts a chain reaction of needing to change array type from string to variant, and it leads to issues in other parts of my program.
Is there any way to approach this that will allow me to retain the string array type? Thanks

You can pass arrays of most types as a Variant between methods and procedures in VBA
Private Function ShiftDownArray(ByRef theArray As Variant) As Variant
Dim i As Integer
ReDim x(0 To UBound(theArray) - 1) As Variant
For i = 0 To UBound(x)
x(i) = theArray(i + 1)
Next i
ShiftDownArray = x
End Function
But more importantly - why would you want to do this anyway? You can just -/+ 1 to the index in the original array?

Is this what you are looking for:
Public Sub ShiftArrayTest()
'Make an 1-bound array
Dim arr1() As String, N As Long, i As Long
N = 10
ReDim arr1(1 To N)
For i = 1 To N
arr1(i) = CStr(i)
Next i
'Now for the shift
Dim arr2() As String
arr2 = ShiftArray(arr1)
End Sub
Public Function ShiftArray(ByRef theArray() As String) As String()
'Now for the shift
Dim i1 As Long, N As Long, i As Long, res() As String
i1 = LBound(theArray): N = UBound(theArray) - i1 + 1
ReDim res(0 To N - 1)
For i = 0 To N - 1
res(i) = theArray(i1 + i)
Next i
ShiftArray = res
End Function
What I am doing here is taking any array and converting it into a 0-bound array.

The Error is most probably in this line: 'ReDim ShiftDownArray(LBound(theArray) - 1 To UBound(theArray) - 1)'
It looks like you're recursively calling itself, which seems odd given there isn't a base case.
See the following example as provided by this website. The gist of it is that it will skip the first element and copy everything over 'to the left'.
Function Array_Shift(arr As Variant) As Variant
' http://www.php.net/manual/en/function.array-shift.php
Dim tempArray As Variant
Dim i As Long
tempArray = arr
' shift elements one position up
' by skipping the first element of the source array
For i = LBound(tempArray) To UBound(tempArray) - 1
tempArray(i) = tempArray(i + 1)
Next i
' remove last element
' which is now empty
ReDim Preserve tempArray(LBound(tempArray) To UBound(tempArray) - 1)
Array_Shift = tempArray
End Function

The trouble is not with passing an array of strings as a parameter - you can pass arrays of any type, as far as I'm aware. However, assigning a value to ShiftDownArray(a - 1) is ambiguous as you could be accessing the a-1th element of the array or passing a - 1 as a parameter to the ShiftDownArray() function.
The Function call on left-hand side of assignment must return Variant or Object. error message hints to this. You are calling the ShiftDownArray() function rather than accessing the array. The compiler knows you are going to assign something to the value returned by the function (because it is followed by an =) but doesn't know the type as it hasn't yet evaluated theArray(a). To ensure that the assignment can complete regardless of the type of theArray(a), the compiler tries to make sure that ShiftDownArray() returns a Variant or Object to which anything can be assigned.
To avoid this error you can create a temporary array which can be accessed in the conventional manner and assign that array to ShiftDownArray to return from the function.
The following code shows this:
Private Function ShiftDownArray(theArray() As String) As String()
ReDim tempArray(LBound(theArray) - 1 To UBound(theArray) - 1) As String
Dim i As Integer
For i = LBound(tempArray) To UBound(tempArray)
tempArray(i) = theArray(i + 1)
Next i
ShiftDownArray = tempArray
End Function

Related

Problem working with variant data type w/vba

I am trying to learn to use variant data type but facing issues.
Public Function z_score(sections As Range, marks As Range) As Variant
Dim n As Integer
Dim score() As Variant 'marks range has a few empty cells and error cells as well
'hence using variant data type
n = UBound(sections.Value)
ReDim score(1 To n, 1 To 2)
score = marks.Value 'assigning marks range values to first column of score
For i = 1 To n 'adding second column with integer index for calling later
score(i, 2) = i
Next i
z_score = score
End Function
I am getting value error instead of nx2 matrix as output.
Can you please help how to resolve the error.
Any help is much appreciated, thanks..
There are a few areas that could cause this code to fail, I'm afraid:
If the passed in range is only 1 cell, the assignment to an array will throw an error.
VBA doesn't have a method for copying or cloning arrays, so your code score = marks.Value isn't doing what your comments are saying,
The sections parameter doesn't appear to be doing anything. You are sizing the array against it, but then iterating the marks array to assign values.
I'm not sure what you want to do with the function, but if it is a UDF called from a worksheet, it would need to be a formula array.
You could adjust your code as follows to have something a little more robust:
Public Function z_score(marks As Range) As Variant
Dim scoreArray() As Variant, marksArray() As Variant
Dim i As Long
marksArray = RangeValueToArray(marks)
ReDim scoreArray(1 To UBound(marksArray, 1), 1 To 2)
For i = 1 To UBound(marksArray, 1)
scoreArray(i, 1) = i
scoreArray(i, 2) = marksArray(i, 1)
Next
z_score = scoreArray
End Function
Private Function RangeValueToArray(rng As Range) As Variant
Dim v() As Variant
If rng.Cells.Count = 1 Then
ReDim v(1 To 1, 1 To 1)
v(1, 1) = rng.Value2
RangeValueToArray = v
Exit Function
End If
v = rng.Value2
RangeValueToArray = v
End Function
I think I figured out the problem. Assigning values of range to array works but makes the assigned array two dimensional array but with only 1 column if given range has only one column or row! So moving the redim with preserve to after assignment line worked for my purpose.
But if one wants to assign values to a column other than first in a 2D array (albeit with 1 column), only solution I am aware of at this point is to do iteration the way Ambie suggested.
Public Function z_score(sections As Range, marks As Range) As Variant
Dim score() As Variant 'marks range has a few empty cells and error cells as well
'hence using variant data type
Dim n As Integer
n = UBound(sections.Value)
score = marks.Value 'assigning marks range values to first column of score
ReDim Preserve score(1 To n, 1 To 2)
For i = 1 To n 'adding second column with integer index for calling later
score(i, 2) = i
Next i
z_score = score
End Function

array push - Write a VBA function that accepts any type of array

I'm trying to write a simple push function that can add an element to my VBA arrays.
I can't figure out how to allow it to accept typed arrays. So far, I can get the function to accept arrays explicitly typed as "Variant". See below
Function push(arr() As Variant, el As Variant) As Variant()
' function to redim an array and increment it by one. If array is length 1 and element is empty, it will place the "el" param in the first index
If IsEmpty(arr(UBound(arr))) And UBound(arr) = LBound(arr) Then
arr(UBound(arr)) = el
Else
ReDim Preserve arr(LBound(arr) To UBound(arr) + 1)
arr(UBound(arr)) = el
End If
push = arr
End Function
Sub testPush()
Dim myArr() As Variant
Dim newArr() As Variant
myArr = Array("apple", "banana", "4")
myArr = push(myArr, "coconut")
Debug.Print Join(myArr, ", ")
newArr = Array(1, 2, 3, 4)
newArr = push(newArr, 7)
Debug.Print Join(newArr, ", ")
End Sub
When I dimension myArr as string, e.g., Dim myArr() as String I see a compile error in my push function: Type mismatch: array or user defined type expected. Is there any way I can use a single function that attempts to increment an element to the end of an array, regardless of the array type?
Contrary to what I write below, maybe someone who knows more than me will tell you this is possible and exactly how you can do this.
I see that your function returns an array of variants:
Function push(arr() As Variant, el As Variant) As Variant()
which, if I understand correctly, can only be assigned to a variable of type Variant or Variant().
If I change the function to:
Function push(arr As Variant, el As Variant) As Variant
I think the function can now accept an array of any type1 but it still returns a Variant -- which I believe can't be assigned to every typed array (meaning you'll still get a compiler error in some cases).
What might be an easier approach is to change the Function to a Sub and have the subroutine modify the array in-place. That way there is no assignment at the call site (since subroutines do not return values) and the code should compile. This also means any type error2 will now occur at run-time.
Also, it's not clear to me what the point of the below is:
If IsEmpty(arr(UBound(arr)))
It seems like you're checking if the array's first element has been assigned something other than its default initialised value. But that check seems like it will only work for Variant types (which are initialised as empty). I think strings are initialised as "", numbers are initialised as 0, objects are initialised as Nothing, and so on. In short, I think the IsEmpty check may return false negative for types other than Variant. The aforementioned behaviour might be what you want, or it might not be (given that you say you want this Push code to work with arrays of any type).
Overall, one approach could be something like:
Option Explicit
Sub Push(ByRef someArray As Variant, ByVal someElement As Variant)
' This routine expects array to be 1-dimensional.
' and will modify the array in-place.
' The array must by dynamic (cannot Redim an array that
' was statically declared).
Dim lastIndex As Long
lastIndex = UBound(someArray)
Dim arrayNeedsExtending As Boolean
' If you are using "IsEmpty" to work out if the first element
' has been assigned a value other than its default value at initialisation
' then you may need to see: https://stackoverflow.com/a/3331239/8811778
' as "IsEmpty" might only work for Variants and may return false
' negatives otherwise.
arrayNeedsExtending = (lastIndex <> LBound(someArray)) Or Not IsEmpty(someArray(lastIndex))
If arrayNeedsExtending Then
ReDim Preserve someArray(LBound(someArray) To (lastIndex + 1))
End If
' If you have an array of objects (hypothetically, instead of a collection), the line below
' will raise a syntax error since Set keyword is required for objects.
someArray(UBound(someArray)) = someElement
End Sub
Private Sub TestPush()
Dim someStrings() As String
someStrings = Split("a,a", ",", -1, vbBinaryCompare)
Push someStrings, "b"
Debug.Assert (JoinArray(someStrings) = "a,a,b")
Dim someBooleans() As Boolean ' Can only Push dynamic arrays
ReDim someBooleans(0 To 1)
Push someBooleans, True
Debug.Assert (JoinArray(someBooleans) = "False,False,True")
Dim someZeros() As Long
ReDim someZeros(0 To 1)
Push someZeros, 0
Debug.Assert (JoinArray(someZeros) = "0,0,0")
End Sub
Private Function JoinArray(ByRef someArray As Variant, Optional delimiter As String = ",") As String
' Expects array to be 1-dimensional.
' Attempts to handle non-string types albeit without error handling.
Dim toJoin() As String
ReDim toJoin(LBound(someArray) To UBound(someArray))
Dim arrayIndex As Long
For arrayIndex = LBound(someArray) To UBound(someArray)
toJoin(arrayIndex) = CStr(someArray(arrayIndex)) ' Will throw if type cannot be coerced into string.
Next arrayIndex
JoinArray = Join(toJoin, delimiter)
End Function
1 Maybe not user-defined types though.
2 Say you pass the string"a" to be pushed into a Long-typed array -- or any value that cannot be type-coerced into the array's type.

value of type integer cannot be converted to object because integer in not reference type

Module Module1
Sub main()
Dim pl(), pll() As Integer
Dim a, b As Integer
ReDim pl(0)
ReDim pll(0)
Do
a = InputBox("insert number:")
If a <> 0 Then
b = b + 1
ReDim Preserve pl(b)
pl(b) = a
End If
Loop Until a = 0
pll = **se(pl)**
End Sub
Function se(pol()) As Integer()
Dim r, t, w, m As Integer
Dim fix() As Integer
ReDim fix(0)
r = UBound(pol)
w = 2
For t = 1 To r
For m = 1 To r
If w <= r Then
If pol(w) < pol(t) Then
ReDim Preserve fix(t)
fix(t) = pol(w)
End If
End If
w = w + 1
Next
Next
se = fix
End Function
End Module
Hi, i created this function(dont know if its working) se(pl) that take array of numbers and return that array but in ascending order. But when I want assign that function into array - pll=se(pl) it gives me this error ==> "value of type integer cannot be converted to object because integer in not reference type"
Im sorry im noob, Can anybody help?
I adjusted your code to make it work. Yet, I tried to stick as much as possible to the original code to make it easier for you to learn from this solution:
Option Base 0
Option Explicit
Sub main()
Dim pl() As Integer
Dim a As Integer, b As Integer
ReDim pl(0)
Do
a = InputBox("insert number:")
If IsNumeric(a) And a <> 0 Then
b = b + 1
ReDim Preserve pl(b)
pl(b) = a
End If
Loop Until a = vbNullString
Debug.Print "Unsorted:"
For a = LBound(pl) To UBound(pl)
Debug.Print pl(a)
Next a
se intArray:=pl
Debug.Print "Sorted:"
For a = LBound(pl) To UBound(pl)
Debug.Print pl(a)
Next a
End Sub
Function se(ByRef intArray() As Integer)
Dim t As Integer, w As Integer, m As Integer
For t = LBound(intArray) To UBound(intArray)
For m = LBound(intArray) To UBound(intArray)
If intArray(t) < intArray(m) Then
w = intArray(t)
intArray(t) = intArray(m)
intArray(m) = w
End If
Next m
Next t
End Function
Some important notes:
(1) If you want to Dim multiple variables in one row then you'll have to repeat the DataType for each variable. So, it is Dim a as Integer, b as Integer and not Dim a, b as Integer. In the latter of the two cases a will be of DataType variant (and not as possibly expected Integer).
(2) To pass arrays in VBA from a procedure to a function you'll have to pass it ByRef. As such, there is no need to created a second or third array (such as pll() or fix()).
(3) There is a VBA command Fix. Hence, you cannot use it for a variable.
Let me know if the above helped or if you require more background or a slight adjustment.
you're tagging both "VBA" and "Visual Studio" but what follows is for VBA only
as to your very code I made it work (meaning it run to the end with no errors) only by substituting fix with fixed, since my Excel VBA "complier" throws a "Syntax error" message due to the existence of the "FIX()" VBA function.
so, after that substitution Function se was called and it returned an integer array with no problems.
but it didn't do what you stated as its due i.e.: "return the passed array in ascending order".
also, both your variable declaration and your input procedure would allow for strings to be passed.
so here follow my proposal to have your code do what you said you need ("return the passed array in ascending order") with a more robust input procedure
Option Explicit
Sub main()
Dim pl() As Integer, pll() As Integer
pl = TryConvertToInt(Split(InputBox("insert numbers (separated by space):")))
pll = se(pl)
End Sub
Function TryConvertToInt(arr As Variant) As Integer()
Dim i As Long, n As Long
ReDim myint(1 To UBound(arr) - LBound(arr) + 1) As Integer
For i = LBound(arr) To UBound(arr)
If IsNumeric(arr(i)) And arr(i) <> 0 Then
n = n + 1
myint(n) = CInt(arr(i))
End If
Next i
ReDim Preserve myint(1 To n) As Integer
TryConvertToInt = myint
End Function
Function se(pol() As Integer) As Integer()
'adapted from https://support.microsoft.com/en-us/kb/133135
Dim Temp As Integer
Dim i As Integer
Dim NoExchanges As Boolean
Dim fixed() As Integer
ReDim fixed(1 To UBound(pol) - LBound(pol) + 1)
fixed = pol
' Loop until no more "exchanges" are made.
Do
NoExchanges = True
' Loop through each element in the array.
' For i = 1 To UBound(pol) - 1
For i = LBound(fixed) To UBound(fixed) - 1
' If the element is greater than the element following it, exchange the two elements.
If fixed(i) > fixed(i + 1) Then
NoExchanges = False
Temp = fixed(i)
fixed(i) = fixed(i + 1)
fixed(i + 1) = Temp
End If
Next i
Loop While Not (NoExchanges)
se = fixed
End Function
as you can see:
the main sub is now very simple and reduced to three statements
the first being the variables declarations one
the second statements nests three calls:
the call to InpuBox function where the user is asked to input all wanted numbers separated by spaces (and no need to have a zero to close the sequence)
the call to Split function to have it parse the input string into a strings array made of as many strings as input ones separated by spaces
the call to TryConvertToInt function that takes care of analyzing the strings array and convert it to an integer array, allowing only numbers other than zeros
the third statement calls se function and puts its return integer array into pll integer array
the se function has a sorting algorithm derived from https://support.microsoft.com/en-us/kb/133135, only adapted to handle integer arrays only.
with such a structure you can now be more effective in coding along since you can concentrate on the main sub to do "main" works (do this, do that, ...) via calls to specific subs and/or functions.
this leaving "non-main" works into specific subs or functions where to concentrate on for specific purpose only: for instance you may want to customize the TryConvertToInt function for more detailed filtering actions

Assigning an array value to a variable in VBA causes my UDF to exit

I can't seem to figure out why this UDF is exiting on the currentInput = inputArray(i). Here is the relevant code:
Function OrderRange(inputRange As Range) As Variant
Dim length As Integer
inputHeight = inputRange.Count
Dim inputArray As Variant
inputArray = inputRange
Dim strippedArray() As Variant
ReDim strippedArray(0 To (inputHeight - 1))
Dim currentInput As String
Dim i As Integer
For i = 0 To (inputHeight - 1)
currentInput = inputArray(i)
'...computations on currentInput...'
strippedArray(i) = currentInput
Next i
OrderRange = strippedArray
End Function
The debugger reaches currentInput = inputArray(i) but once I move to the next line, the function terminates and a #VALUE! error is entered into the cell I call the function from. I know this is a specific question, but I'm sure it's a general issue and I'll edit this original post to reflect what the general problem is.
Edit: This is an issue regarding assignment of a range to a variant array.
Variant arrays created by setting them equal to ranges have two dimensions even if they are only one column, or row, wide. So if you call the function with A1:A10 you'll get a 10 * 1 array. Also the lower bound of the dimensions will be one, not zero. So you'd have to do something like:
For i = 1 To (inputHeight)
currentInput = inputArray(i, 1)
Also you should use Option Explicit so that you're reminded to declare all variables. InputHeight is never declared.

How do I determine if an array is initialized in VB6?

Passing an undimensioned array to the VB6's Ubound function will cause an error, so I want to check if it has been dimensioned yet before attempting to check its upper bound. How do I do this?
Note: the code has been updated, the original version can be found in the revision history (not that it is useful to find it). The updated code does not depend on the undocumented GetMem4 function and correctly handles arrays of all types.
Note for VBA users: This code is for VB6 which never got an x64 update. If you intend to use this code for VBA, see https://stackoverflow.com/a/32539884/11683 for the VBA version. You will only need to take the CopyMemory declaration and the pArrPtr function, leaving the rest.
I use this:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Private Const VT_BYREF As Long = &H4000&
' When declared in this way, the passed array is wrapped in a Variant/ByRef. It is not copied.
' Returns *SAFEARRAY, not **SAFEARRAY
Public Function pArrPtr(ByRef arr As Variant) As Long
'VarType lies to you, hiding important differences. Manual VarType here.
Dim vt As Integer
CopyMemory ByVal VarPtr(vt), ByVal VarPtr(arr), Len(vt)
If (vt And vbArray) <> vbArray Then
Err.Raise 5, , "Variant must contain an array"
End If
'see https://msdn.microsoft.com/en-us/library/windows/desktop/ms221627%28v=vs.85%29.aspx
If (vt And VT_BYREF) = VT_BYREF Then
'By-ref variant array. Contains **pparray at offset 8
CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr) 'pArrPtr = arr->pparray;
CopyMemory ByVal VarPtr(pArrPtr), ByVal pArrPtr, Len(pArrPtr) 'pArrPtr = *pArrPtr;
Else
'Non-by-ref variant array. Contains *parray at offset 8
CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr) 'pArrPtr = arr->parray;
End If
End Function
Public Function ArrayExists(ByRef arr As Variant) As Boolean
ArrayExists = pArrPtr(arr) <> 0
End Function
Usage:
? ArrayExists(someArray)
Your code seems to do the same (testing for SAFEARRAY** being NULL), but in a way which I would consider a compiler bug :)
I just thought of this one. Simple enough, no API calls needed. Any problems with it?
Public Function IsArrayInitialized(arr) As Boolean
Dim rv As Long
On Error Resume Next
rv = UBound(arr)
IsArrayInitialized = (Err.Number = 0)
End Function
Edit: I did discover a flaw with this related to the behavior of the Split function (actually I'd call it a flaw in the Split function). Take this example:
Dim arr() As String
arr = Split(vbNullString, ",")
Debug.Print UBound(arr)
What is the value of Ubound(arr) at this point? It's -1! So, passing this array to this IsArrayInitialized function would return true, but attempting to access arr(0) would cause a subscript out of range error.
Here's what I went with. This is similar to GSerg's answer, but uses the better documented CopyMemory API function and is entirely self-contained (you can just pass the array rather than ArrPtr(array) to this function). It does use the VarPtr function, which Microsoft warns against, but this is an XP-only app, and it works, so I'm not concerned.
Yes, I know this function will accept anything you throw at it, but I'll leave the error checking as an exercise for the reader.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Function ArrayIsInitialized(arr) As Boolean
Dim memVal As Long
CopyMemory memVal, ByVal VarPtr(arr) + 8, ByVal 4 'get pointer to array
CopyMemory memVal, ByVal memVal, ByVal 4 'see if it points to an address...
ArrayIsInitialized = (memVal <> 0) '...if it does, array is intialized
End Function
I found this:
Dim someArray() As Integer
If ((Not someArray) = -1) Then
Debug.Print "this array is NOT initialized"
End If
Edit: RS Conley pointed out in his answer that (Not someArray) will sometimes return 0, so you have to use ((Not someArray) = -1).
Both methods by GSerg and Raven are undocumented hacks but since Visual BASIC 6 is no longer being developed then it is not a issue. However Raven's example doesn't work on all machines. You have to test like this.
If (Not someArray) = -1 Then
On some machines it will return a zero on others some large negative number.
In VB6 there is a function called "IsArray", but it does not check if the array has been initialized. You will receive Error 9 - Subscript out of range if you attempt to use UBound on an uninitialized array. My method is very similar to S J's, except it works with all variable types and has error handling. If a non-array variable is checked, you will receive Error 13 - Type Mismatch.
Private Function IsArray(vTemp As Variant) As Boolean
On Error GoTo ProcError
Dim lTmp As Long
lTmp = UBound(vTemp) ' Error would occur here
IsArray = True: Exit Function
ProcError:
'If error is something other than "Subscript
'out of range", then display the error
If Not Err.Number = 9 Then Err.Raise (Err.Number)
End Function
Since wanted comment on here will post answer.
Correct answer seems is from #raven:
Dim someArray() As Integer
If ((Not someArray) = -1) Then
Debug.Print "this array is NOT initialized"
End If
When documentation or Google does not immediately return an explanation people tend to call it a hack.
Although what seems to be the explanation is that Not is not only a Logical, it is also a Bitwise operator, so it handles the bit representation of structures, rather than Booleans only.
For example of another bitwise operation is here:
Dim x As Integer
x = 3 And 5 'x=1
So the above And is also being treated as a bitwise operator.
Furthermore, and worth to check, even if not the directly related with this,
The Not operator can be overloaded, which means that a class or
structure can redefine its behavior when its operand has the type of
that class or structure.
Overloading
Accordingly, Not is interpreting the array as its bitwise representation and it distinguishes output when array is empty or not like differently in the form of signed number. So it can be considered this is not a hack, is just an undocumentation of the array bitwise representation, which Not here is exposing and taking advantage of.
Not takes a single operand and inverts all the bits, including the
sign bit, and assigns that value to the result. This means that for
signed positive numbers, Not always returns a negative value, and for
negative numbers, Not always returns a positive or zero value.
Logical Bitwise
Having decided to post since this offered a new approach which is welcome to be expanded, completed or adjusted by anyone who has access to how arrays are being represented in their structure. So if anyone offers proof it is actually not intended for arrays to be treated by Not bitwise we should accept it as not a hack and actually as best clean answer, if they do or do not offer any support for this theory, if it is constructive comment on this is welcome of course.
This is modification of raven's answer. Without using API's.
Public Function IsArrayInitalized(ByRef arr() As String) As Boolean
'Return True if array is initalized
On Error GoTo errHandler 'Raise error if directory doesnot exist
Dim temp As Long
temp = UBound(arr)
'Reach this point only if arr is initalized i.e. no error occured
If temp > -1 Then IsArrayInitalized = True 'UBound is greater then -1
Exit Function
errHandler:
'if an error occurs, this function returns False. i.e. array not initialized
End Function
This one should also be working in case of split function.
Limitation is you would need to define type of array (string in this example).
When you initialite the array put an integer or boolean with a flag = 1. and query this flag when you need.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
Private Type SafeArray
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
End Type
Private Function ArrayInitialized(ByVal arrayPointer As Long) As Boolean
Dim pSafeArray As Long
CopyMemory pSafeArray, ByVal arrayPointer, 4
Dim tArrayDescriptor As SafeArray
If pSafeArray Then
CopyMemory tArrayDescriptor, ByVal pSafeArray, LenB(tArrayDescriptor)
If tArrayDescriptor.cDims > 0 Then ArrayInitialized = True
End If
End Function
Usage:
Private Type tUDT
t As Long
End Type
Private Sub Form_Load()
Dim longArrayNotDimmed() As Long
Dim longArrayDimmed(1) As Long
Dim stringArrayNotDimmed() As String
Dim stringArrayDimmed(1) As String
Dim udtArrayNotDimmed() As tUDT
Dim udtArrayDimmed(1) As tUDT
Dim objArrayNotDimmed() As Collection
Dim objArrayDimmed(1) As Collection
Debug.Print "longArrayNotDimmed " & ArrayInitialized(ArrPtr(longArrayNotDimmed))
Debug.Print "longArrayDimmed " & ArrayInitialized(ArrPtr(longArrayDimmed))
Debug.Print "stringArrayNotDimmed " & ArrayInitialized(ArrPtr(stringArrayNotDimmed))
Debug.Print "stringArrayDimmed " & ArrayInitialized(ArrPtr(stringArrayDimmed))
Debug.Print "udtArrayNotDimmed " & ArrayInitialized(ArrPtr(udtArrayNotDimmed))
Debug.Print "udtArrayDimmed " & ArrayInitialized(ArrPtr(udtArrayDimmed))
Debug.Print "objArrayNotDimmed " & ArrayInitialized(ArrPtr(objArrayNotDimmed))
Debug.Print "objArrayDimmed " & ArrayInitialized(ArrPtr(objArrayDimmed))
Unload Me
End Sub
Based on all the information I read in this existing post this works the best for me when dealing with a typed array that starts as uninitialized.
It keeps the testing code consistent with the usage of UBOUND and It does not require the usage of error handling for testing.
It IS dependent on Zero Based Arrays (which is the case in most development).
Must not use "Erase" to clear the array. use alternative listed below.
Dim data() as string ' creates the untestable holder.
data = Split(vbNullString, ",") ' causes array to return ubound(data) = -1
If Ubound(data)=-1 then ' has no contents
' do something
End If
redim preserve data(Ubound(data)+1) ' works to increase array size regardless of it being empty or not.
data = Split(vbNullString, ",") ' MUST use this to clear the array again.
The easiest way to handle this is to insure that the array is initialized up front, before you need to check for the Ubound. I needed an array that was declared in the (General) area of the form code.
i.e.
Dim arySomeArray() As sometype
Then in the form load routine I redim the array:
Private Sub Form_Load()
ReDim arySomeArray(1) As sometype 'insure that the array is initialized
End Sub
This will allow the array to be re-defined at any point later in the program.
When you find out how big the array needs to be just redim it.
ReDim arySomeArray(i) As sometype 'i is the size needed to hold the new data
The title of the question asks how to determine if an array is initialized, but, after reading the question, it looks like the real problem is how to get the UBound of an array that is not initialized.
Here is my solution (to the the actual problem, not to the title):
Function UBound2(Arr) As Integer
On Error Resume Next
UBound2 = UBound(Arr)
If Err.Number = 9 Then UBound2 = -1
On Error GoTo 0
End Function
This function works in the following four scenarios, the first three that I have found when Arr is created by an external dll COM and the fourth when the Arr is not ReDim-ed (the subject of this question):
UBound(Arr) works, so calling UBound2(Arr) adds a little overhead, but doesn't hurt much
UBound(Arr) fails in in the function that defines Arr, but succeeds inside UBound2()
UBound(Arr) fails both in the function that defines Arr and in UBound2(), so the error handling does the job
After Dim Arr() As Whatever, before ReDim Arr(X)
For any variable declared as an array, you can easily check if the array is initialized by calling the SafeArrayGetDim API. If the array is initialized, then the return value will be non-zero, otherwise the function returns zero.
Note that you can't use this function with variants that contain arrays. Doing so will cause a Compile error (Type mismatch).
Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (psa() As Any) As Long
Public Sub Main()
Dim MyArray() As String
Debug.Print SafeArrayGetDim(MyArray) ' zero
ReDim MyArray(64)
Debug.Print SafeArrayGetDim(MyArray) ' non-zero
Erase MyArray
Debug.Print SafeArrayGetDim(MyArray) ' zero
ReDim MyArray(31, 15, 63)
Debug.Print SafeArrayGetDim(MyArray) ' non-zero
Erase MyArray
Debug.Print SafeArrayGetDim(MyArray) ' zero
ReDim MyArray(127)
Debug.Print SafeArrayGetDim(MyArray) ' non-zero
Dim vArray As Variant
vArray = MyArray
' If you uncomment the next line, the program won't compile or run.
'Debug.Print SafeArrayGetDim(vArray) ' <- Type mismatch
End Sub
If the array is a string array, you can use the Join() method as a test:
Private Sub Test()
Dim ArrayToTest() As String
MsgBox StringArrayCheck(ArrayToTest) ' returns "false"
ReDim ArrayToTest(1 To 10)
MsgBox StringArrayCheck(ArrayToTest) ' returns "true"
ReDim ArrayToTest(0 To 0)
MsgBox StringArrayCheck(ArrayToTest) ' returns "false"
End Sub
Function StringArrayCheck(o As Variant) As Boolean
Dim x As String
x = Join(o)
StringArrayCheck = (Len(x) <> 0)
End Function
My only problem with API calls is moving from 32-bit to 64-bit OS's.
This works with Objects, Strings, etc...
Public Function ArrayIsInitialized(ByRef arr As Variant) As Boolean
On Error Resume Next
ArrayIsInitialized = False
If UBound(arr) >= 0 Then If Err.Number = 0 Then ArrayIsInitialized = True
End Function
If ChkArray(MyArray)=True then
....
End If
Public Function ChkArray(ByRef b) As Boolean
On Error goto 1
If UBound(b) > 0 Then ChkArray = True
End Function
You can solve the issue with Ubound() function, check if the array is empty by retrieving total elements count using JScript's VBArray() object (works with arrays of variant type, single or multidimensional):
Sub Test()
Dim a() As Variant
Dim b As Variant
Dim c As Long
' Uninitialized array of variant
' MsgBox UBound(a) ' gives 'Subscript out of range' error
MsgBox GetElementsCount(a) ' 0
' Variant containing an empty array
b = Array()
MsgBox GetElementsCount(b) ' 0
' Any other types, eg Long or not Variant type arrays
MsgBox GetElementsCount(c) ' -1
End Sub
Function GetElementsCount(aSample) As Long
Static oHtmlfile As Object ' instantiate once
If oHtmlfile Is Nothing Then
Set oHtmlfile = CreateObject("htmlfile")
oHtmlfile.parentWindow.execScript ("function arrlength(arr) {try {return (new VBArray(arr)).toArray().length} catch(e) {return -1}}"), "jscript"
End If
GetElementsCount = oHtmlfile.parentWindow.arrlength(aSample)
End Function
For me it takes about 0.4 mksec for each element + 100 msec initialization, being compiled with VB 6.0.9782, so the array of 10M elements takes about 4.1 sec. The same functionality could be implemented via ScriptControl ActiveX.
There are two slightly different scenarios to test:
The array is initialised (effectively it is not a null pointer)
The array is initialised and has at least one element
Case 2 is required for cases like Split(vbNullString, ",") which returns a String array with LBound=0 and UBound=-1.
Here are the simplest example code snippets I can produce for each test:
Public Function IsInitialised(arr() As String) As Boolean
On Error Resume Next
IsInitialised = UBound(arr) <> 0.5
End Function
Public Function IsInitialisedAndHasElements(arr() As String) As Boolean
On Error Resume Next
IsInitialisedAndHasElements = UBound(arr) >= LBound(arr)
End Function
Either of these two ways is valid to detect an uninitialized array, but they must include the parentheses:
(Not myArray) = -1
(Not Not myArray) = 0
' Function CountElements return counted elements of an array.
' Returns:
' [ -1]. If the argument is not an array.
' [ 0]. If the argument is a not initialized array.
' [Count of elements]. If the argument is an initialized array.
Private Function CountElements(ByRef vArray As Variant) As Integer
' Check whether the argument is an array.
If (VarType(vArray) And vbArray) <> vbArray Then
' Not an array. CountElements is set to -1.
Let CountElements = -1
Else
On Error Resume Next
' Calculate number of elements in array.
' Scenarios:
' - Array is initialized. CountElements is set to counted elements.
' - Array is NOT initialized. CountElements is never set and keeps its
' initial value of zero (since an error is
' raised).
Let CountElements = (UBound(vArray) - LBound(vArray)) + 1
End If
End Function
' Test of function CountElements.
Dim arrStr() As String
Dim arrV As Variant
Let iCount = CountElements(arrStr) ' arrStr is not initialized, returns 0.
ReDim arrStr(2)
Let iCount = CountElements(arrStr) ' arrStr is initialized, returns 3.
ReDim arrStr(5 To 8)
Let iCount = CountElements(arrStr) ' arrStr is initialized, returns 4.
Let arrV = arrStr
Let iCount = CountElements(arrV) ' arrV contains a boxed arrStr which is initialized, returns 4
Erase arrStr
Let iCount = CountElements(arrStr) ' arrStr size is erased, returns 0.
Let iCount = CountElements(Nothing) ' Nothing is not an array, returns -1.
Let iCount = CountElements(Null) ' Null is not an array, returns -1.
Let iCount = CountElements(5) ' Figure is not an array, returns -1.
Let iCount = CountElements("My imaginary array") ' Text is not an array, returns -1.
Let iCount = CountElements(Array(1, 2, 3, 4, 5)) ' Created array of Integer elements, returns 5.
Let iCount = CountElements(Array("A", "B", "C")) ' Created array of String elements, returns 3.
I see a lot of suggestions online about how to tell if an array has been initialized. Below is a function that will take any array, check what the ubound of that array is, redimension the array to ubound +1 (with or without PRESERVER) and then return what the current ubound of the array is, without errors.
Function ifuncRedimUbound(ByRef byrefArr, Optional bPreserve As Boolean)
On Error GoTo err:
1: Dim upp%: upp% = (UBound(byrefArr) + 1)
errContinue:
If bPreserve Then
ReDim Preserve byrefArr(upp%)
Else
ReDim byrefArr(upp%)
End If
ifuncRedimUbound = upp%
Exit Function
err:
If err.Number = 0 Then Resume Next
If err.Number = 9 Then ' subscript out of range (array has not been initialized yet)
If Erl = 1 Then
upp% = 0
GoTo errContinue:
End If
Else
ErrHandler.ReportError "modArray", ifuncRedimUbound, "1", err.Number, err.Description
End If
End Function
This worked for me, any bug in this?
If IsEmpty(a) Then
Exit Function
End If
MSDN
Dim someArray() as Integer
If someArray Is Nothing Then
Debug.print "this array is not initialised"
End If

Resources