Keith wrote:
Using XL 2003.
I generally set Option Base 1 in my projects, as a personal preference (MS
gave us the option, so I'd think either way is ok).

However, even in Option Base 1 project, some arrays don't start with 1, such
as:

Option Base 1
Sub testme
CArray = Array(1,2,3,4)
Msgbox CArray(1) 'returns a value of 2
End Sub

Is there a way to ensure that these 'on the fly' arrays also start with Base
1, or am I stuck with having mixed array types if I assign these arrays on
the fly?

Thanks!
Keith


If you use the following function you can code

CArray=ConvertBase(Array(1,2,3,4),1) or, in Nick HK's example

CArray = ConvertBase(Split("1,2,3,4", ","),1),

for 1-D, 2-D and 3-D arrays

Function ConvertBase(ByRef InputArray, _
ByVal ResultingBase1 As Long, _
Optional ByVal ResultingBase2, _
Optional ByVal ResultingBase3)
'This function converts the base(s) of an
'input array to the integer(s) that is/are
'input as the ResultingBase argument(s).
'It accepts arrays with base(s) equal to
'the number(s) of the ResultingBase argument(s),
'simply leaving them as is. It returns the
'converted array for use in other functions.

Dim ina, outa, Msg As String
Dim i As Long, j As Long, p As Integer
Dim rb1 As Long, rb2 As Long, rb3 As Long
Dim lb1 As Long, lb2 As Long, ub1 As Long, ub2 As Long


'Insure that InputArray is an array
If Not IsArray(InputArray) Or IsObject(InputArray) Then
Msg = "The first argument to this function must be an array."
If TypeOf Application.Caller Is Range Then
ConvertBase = Msg: Exit Function
Else
MsgBox Msg, 16: Exit Function
End If
End If

'Determine the number of dimensions of InputArray
On Error Resume Next
i = 1
Do
z = UBound(InputArray, i)
i = i + 1
Loop While Err = 0
Err = 0
On Error GoTo 0

'Assign dimensions of InputArray to a variable
p = i - 2

'Insure that InputArray is not greater than 3-Dimensional
Msg = "Function does not accept arrays with more than 3 dimensions"
If p 3 Then
If TypeOf Application.Caller Is Range Then
ConvertBase = Msg: Exit Function
Else
MsgBox Msg, 16: Exit Function
End If
End If

'For convenience in referring to ResultingBase
rb1 = ResultingBase1
If Not IsMissing(ResultingBase2) Then
If Not TypeName(ResultingBase2) = "Integer" _
And Not TypeName(ResultingBase2) = "Long" Then
Msg = "The optional second argument must be an integer"
If TypeOf Application.Caller Is Range Then
ConvertBase = Msg: Exit Function
Else
MsgBox Msg, 16: Exit Function
End If
End If
rb2 = ResultingBase2
ElseIf p 1 Then
rb2 = LBound(InputArray, 2)
End If
If Not IsMissing(ResultingBase3) Then
If Not TypeName(ResultingBase3) = "Integer" _
And Not TypeName(ResultingBase3) = "Long" Then
Msg = "The optional third argument must be an integer"
If TypeOf Application.Caller Is Range Then
ConvertBase = Msg: Exit Function
Else
MsgBox Msg, 16: Exit Function
End If
End If
rb3 = ResultingBase3
ElseIf p = 3 Then
rb3 = LBound(InputArray, 3)
End If

'For convenience in referring to InputArray
ina = InputArray
lb1 = LBound(ina, 1)
ub1 = UBound(ina, 1)

If p = 1 Then

'Redimension and load the 1-D output array
Select Case TypeName(ina)
Case "Object()"
ReDim outa(rb1 To ub1 - lb1 + rb1) As Object
For i = rb1 To ub1 - lb1 + rb1
Set outa(i) = ina(i + lb1 - rb1)
Next
Case "Boolean()"
ReDim outa(rb1 To ub1 - lb1 + rb1) As Boolean
Case "Byte()"
ReDim outa(rb1 To ub1 - lb1 + rb1) As Byte
Case "Currency()"
ReDim outa(rb1 To ub1 - lb1 + rb1) As Currency
Case "Date()"
ReDim outa(rb1 To ub1 - lb1 + rb1) As Date
Case "Double()"
ReDim outa(rb1 To ub1 - lb1 + rb1) As Double
Case "Integer()"
ReDim outa(rb1 To ub1 - lb1 + rb1) As Integer
Case "Long()"
ReDim outa(rb1 To ub1 - lb1 + rb1) As Long
Case "Single()"
ReDim outa(rb1 To ub1 - lb1 + rb1) As Single
Case "String()"
ReDim outa(rb1 To ub1 - lb1 + rb1) As String
Case "Variant()"
ReDim outa(rb1 To ub1 - lb1 + rb1) As Variant
Case Else
Msg = "The function accepts arrays of only built-in types."
If TypeOf Application.Caller Is Range Then
ConvertBase = Msg: Exit Function
Else
MsgBox Msg, 16: Exit Function
End If
End Select

If TypeName(outa) < "Object()" Then
For i = rb1 To ub1 - lb1 + rb1
outa(i) = ina(i + lb1 - rb1)
Next
End If

ElseIf p = 2 Or p = 3 Then

'For convenience in reference
lb2 = LBound(ina, 2)
ub2 = UBound(ina, 2)
If p = 2 Then
'Redimension and load the 2-D output array
Select Case TypeName(ina)
Case "Object()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2) As Object
For i = rb1 To ub1 - lb1 + rb1
For j = rb2 To ub2 - lb2 + rb2
Set outa(i, j) = ina(i + lb1 - rb1, j + lb2 - rb2)
Next
Next
Case "Boolean()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2) As Boolean
Case "Byte()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2) As Byte
Case "Currency()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2) As Currency
Case "Date()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2) As Date
Case "Double()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2) As Double
Case "Integer()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2) As Integer
Case "Long()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2) As Long
Case "Single()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2) As Single
Case "String()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2) As String
Case "Variant()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2) As Variant
Case Else
Msg = "The function accepts arrays of only built-in types."
If TypeOf Application.Caller Is Range Then
ConvertBase = Msg: Exit Function
Else
MsgBox Msg, 16: Exit Function
End If
End Select

If TypeName(ina) < "Object()" Then
For i = rb1 To ub1 - lb1 + rb1
For j = rb2 To ub2 - lb2 + rb2
outa(i, j) = ina(i + lb1 - rb1, j + lb2 - rb2)
Next
Next
End If

ElseIf p = 3 Then

'For convenience in reference
lb3 = LBound(ina, 3)
ub3 = UBound(ina, 3)

'Redimension and load the 3-D output array
Select Case TypeName(ina)
Case "Object()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2, rb3 To ub3 - lb3 + rb3) As Object
For i = rb1 To ub1 - lb1 + rb1
For j = rb2 To ub2 - lb2 + rb2
For k = rb3 To ub3 - lb3 + rb3
Set outa(i, j, k) = ina(i + lb1 - rb1, j +
lb2 - rb2, k + lb3 - rb3)
Next
Next
Next
Case "Boolean()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2, rb3 To ub3 - lb3 + rb3) As Boolean
Case "Byte()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2, rb3 To ub3 - lb3 + rb3) As Byte
Case "Currency()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2, rb3 To ub3 - lb3 + rb3) As Currency
Case "Date()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2, rb3 To ub3 - lb3 + rb3) As Date
Case "Double()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2, rb3 To ub3 - lb3 + rb3) As Double
Case "Integer()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2, rb3 To ub3 - lb3 + rb3) As Integer
Case "Long()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2, rb3 To ub3 - lb3 + rb3) As Long
Case "Single()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2, rb3 To ub3 - lb3 + rb3) As Single
Case "String()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2, rb3 To ub3 - lb3 + rb3) As String
Case "Variant()"
ReDim outa(rb1 To ub1 - lb1 + rb1, rb2 To ub2 - lb2 +
rb2, rb3 To ub3 - lb3 + rb3) As Variant
Case Else
Msg = "The function accepts arrays of only built-in types."
If TypeOf Application.Caller Is Range Then
ConvertBase = Msg: Exit Function
Else
MsgBox Msg, 16: Exit Function
End If
End Select

If TypeName(ina) < "Object()" Then
For i = rb1 To ub1 - lb1 + rb1
For j = rb2 To ub2 - lb2 + rb2
For k = rb3 To ub3 - lb3 + rb3
outa(i, j, k) = ina(i + lb1 - rb1, j + lb2 -
rb2, k + lb3 - rb3)
Next
Next
Next
End If
End If
End If

'Convert the input array to the resulting base
InputArray = outa

'Return converted array for calls from other functions
ConvertBase = outa

End Function