Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 783
Default Changing a two-dimensional, one row array to one-dimensional

The typical way to accomplish the above diseminated in these newsgroups
has been

myArray2 = Application.Transpose(Application.Transpose(myArra y1))

Less typical, but equally effective, is

myArray2 = Application.Index(myArray1, 1, 0)

Both of these methods have the following limitations: they don't work on
large arrays (i.e., arrays of more than 65536 elements in Excel2007;
arrays of much fewer elements in earlier versions); and they both
produce a myArray2 of the Variant() type, even if myArray1 is of a
different built-in type.

The following function avoids those limitations (watch for wordwrap). It
invokes the function ArrayDimensions, which is freely downloadable with
the file at http://home.pacbell.net/beban, and which is also included
below for convenience.

Function ChangeToOneD(inputArray)
If Not IsArray(inputArray) Then
GoTo ErrMsg
ElseIf TypeOf inputArray Is Range Then
GoTo ErrMsg
ElseIf ArrayDimensions(inputArray) < 2 Or UBound(inputArray) 1 Then
GoTo ErrMsg
Else
Dim arrOut
x = TypeName(inputArray)
If x = "Object()" Then
ReDim arrOut(LBound(inputArray,2) To UBound(inputArray,2))
As Object
For i = LBound(inputArray, 2) To UBound(inputArray, 2)
Set arrOut(i) = inputArray(1, i)
Next
ChangeToOneD = arrOut
Exit Function
End If
Select Case x
Case "Boolean()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Boolean
Case "Byte()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Byte
Case "Currency()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Currency
Case "Date()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Date
Case "Double()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Double
Case "Integer()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Integer
Case "Long()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Long
Case "Single()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Single
Case "String()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As String
Case "Variant()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Variant
Case Else
GoTo ErrMsg
End Select
For i = LBound(inputArray, 2) To UBound(inputArray, 2)
arrOut(i) = inputArray(1, i)
Next
ChangeToOneD = arrOut
End If
Exit Function
ErrMsg: Msg = "The function accepts only 2-dimensional, single row VBA
arrays of a built-in type."
MsgBox Msg, 16
End Function

Function ArrayDimensions(InputArray As Variant)
'This function returns the number of dimensions
'of the input array. It contains a loop that was
'suggested in the .programming group by Dana DeLouis.

'Declare variables
Dim arr1, i As Integer, z As Long

If Not TypeName(InputArray) Like "*()" Then
Msg = "#ERROR! The function accepts only arrays."
If TypeOf Application.Caller Is Range Then
ArrayDimensions = Msg
Else
MsgBox Msg, 16
End If
Exit Function
End If

On Error Resume Next

'Loop until an error occurs
i = 1
Do
z = UBound(InputArray, i)
i = i + 1
Loop While Err = 0

'Reset the error value for use with other procedures
Err = 0

'Return the number of dimensions
ArrayDimensions = i - 2


End Function

Alan Beban
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Changing a two-dimensional, one row array to one-dimensional

It is better to break up complicated If statements into smaller pieces. Here
is code that will work. It is pretty easy to understand this code.


Sub Test()
'Cell A1 contains drop down list selection
If Range("A1") = "American Express" Then
CCNumber = 15
Else
CCNumber = 16
End If

If Len(EnteredNumber) < CCNumber Then
MsgBox ("Invalid Credit Card Number")
Else

'enter you code here
End If

End Sub


"Alan Beban" wrote:

The typical way to accomplish the above diseminated in these newsgroups
has been

myArray2 = Application.Transpose(Application.Transpose(myArra y1))

Less typical, but equally effective, is

myArray2 = Application.Index(myArray1, 1, 0)

Both of these methods have the following limitations: they don't work on
large arrays (i.e., arrays of more than 65536 elements in Excel2007;
arrays of much fewer elements in earlier versions); and they both
produce a myArray2 of the Variant() type, even if myArray1 is of a
different built-in type.

The following function avoids those limitations (watch for wordwrap). It
invokes the function ArrayDimensions, which is freely downloadable with
the file at http://home.pacbell.net/beban, and which is also included
below for convenience.

Function ChangeToOneD(inputArray)
If Not IsArray(inputArray) Then
GoTo ErrMsg
ElseIf TypeOf inputArray Is Range Then
GoTo ErrMsg
ElseIf ArrayDimensions(inputArray) < 2 Or UBound(inputArray) 1 Then
GoTo ErrMsg
Else
Dim arrOut
x = TypeName(inputArray)
If x = "Object()" Then
ReDim arrOut(LBound(inputArray,2) To UBound(inputArray,2))
As Object
For i = LBound(inputArray, 2) To UBound(inputArray, 2)
Set arrOut(i) = inputArray(1, i)
Next
ChangeToOneD = arrOut
Exit Function
End If
Select Case x
Case "Boolean()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Boolean
Case "Byte()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Byte
Case "Currency()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Currency
Case "Date()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Date
Case "Double()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Double
Case "Integer()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Integer
Case "Long()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Long
Case "Single()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Single
Case "String()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As String
Case "Variant()"
ReDim arrOut(LBound(inputArray, 2) To
UBound(inputArray, 2)) As Variant
Case Else
GoTo ErrMsg
End Select
For i = LBound(inputArray, 2) To UBound(inputArray, 2)
arrOut(i) = inputArray(1, i)
Next
ChangeToOneD = arrOut
End If
Exit Function
ErrMsg: Msg = "The function accepts only 2-dimensional, single row VBA
arrays of a built-in type."
MsgBox Msg, 16
End Function

Function ArrayDimensions(InputArray As Variant)
'This function returns the number of dimensions
'of the input array. It contains a loop that was
'suggested in the .programming group by Dana DeLouis.

'Declare variables
Dim arr1, i As Integer, z As Long

If Not TypeName(InputArray) Like "*()" Then
Msg = "#ERROR! The function accepts only arrays."
If TypeOf Application.Caller Is Range Then
ArrayDimensions = Msg
Else
MsgBox Msg, 16
End If
Exit Function
End If

On Error Resume Next

'Loop until an error occurs
i = 1
Do
z = UBound(InputArray, i)
i = i + 1
Loop While Err = 0

'Reset the error value for use with other procedures
Err = 0

'Return the number of dimensions
ArrayDimensions = i - 2


End Function

Alan Beban

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
3 dimensional array gti_jobert[_7_] Excel Programming 2 February 2nd 06 03:00 PM
Create One-Dimensional Array from Two-Dimensional Array Stratuser Excel Programming 1 February 23rd 05 08:46 PM
Do I need a two dimensional array for this? hotherps[_17_] Excel Programming 1 February 20th 04 04:46 PM
add to two dimensional array GUS Excel Programming 1 August 26th 03 12:12 AM
2 Dimensional Array steve Excel Programming 0 August 18th 03 07:19 PM


All times are GMT +1. The time now is 10:24 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"