Binaryworld - ArrayAny - Return an initialized array of any type ... [ VB -> Arrays ]

' Returns an array and initializes it with passed data.
'
' It is similar to the Array function, but it works with
' array of any type. The type of the returned array is
' assumed to be the type of the first element in the
' parameter list, so you might need to force a given
' data type using one of the VB's data conversion functions
'
' Example: return the array of the first 8 prime numbers, as Longs
'   primes() = ArrayAny(2&, 3, 5, 7, 11, 13, 17, 19)
' or
'   primes() = ArrayAny(CLng(2), 3, 5, 7, 11, 13, 17, 19)

Function ArrayAny(ParamArray values() As Variant) As Variant
  Dim i As Long
  Dim maxEl As Long
  Dim res As Variant

  maxEl = UBound(values)

  ' we can't use the vbObject constant for objects
  ' because the VarType() function might return
  ' the type of the object's default property
  If IsObject(values(0)) Then
    ReDim arrObj(0 To maxEl) As Object
    ' we need a separate loop, too
    For i = 0 To maxEl
      Set arrObj(i) = values(i)
    Next
    ArrayAny = arrObj()
    Exit Function
  End If

  ' create different arrays, depending on the
  ' type of the first argument
  Select Case VarType(values(0))
    Case vbInteger
      ReDim arrInt(0 To maxEl) As Integer
      res = arrInt()
    Case vbLong
      ReDim arrLng(0 To maxEl) As Long
      res = arrLng()
    Case vbSingle
      ReDim arrSng(0 To maxEl) As Single
      res = arrSng()
    Case vbDouble
      ReDim arrDbl(0 To maxEl) As Double
      res = arrDbl()
    Case vbCurrency
      ReDim arrCur(0 To maxEl) As Currency
      res = arrCur()
    Case vbString
      ReDim arrStr(0 To maxEl) As String
      res = arrStr()
    Case vbDate
      ReDim arrDat(0 To maxEl) As Date
      res = arrDat()
    Case vbBoolean
      ReDim arrBol(0 To maxEl) As Boolean
      res = arrBol()
    Case Else
      ' unsupported data type
      ' (might be a UDT or an array)
      Err.Raise 5
  End Select

  ' now we can copy all values into the array
  For i = 0 To maxEl
    res(i) = values(i)
  Next
  ArrayAny = res
End Function