I have decided to start releasing code that should be backward compatible to excel 2007.
The following UDF should be able to be added to any version of Excel 2007 or newer version of excel and perform very similar to the excel 365 function CHOOSECOLS.
Let me know your positive or negative results, please give examples of what you tested when posting your results so we can make any corrections that I am sure will need to be made.
The following UDF should be able to be added to any version of Excel 2007 or newer version of excel and perform very similar to the excel 365 function CHOOSECOLS.
VBA Code:
Function CHOOSECOLS(data As Range, ParamArray col_nums() As Variant) As Variant ' Excel 365
'
Dim ArrayColumn As Long, ArrayRow As Long
Dim ArrayDimensionFoundValue As Long, MaximumDimension As Long
Dim DataColumnNumber As Long, ChosenColumnNumber As Long, ColumnsChosenCount As Long
Dim CHOOSECOLS_Array As Variant, col_nums_Array As Variant, TempArray As Variant
'
' Check if input is a range or array
If TypeName(col_nums(0)) = "Range" Then ' If col_nums(0) is a range then ...
If col_nums(0).Cells.count = 1 Then ' If the range(0) is detected as 1 cell then ...
If UBound(col_nums) = 0 Then ' If there is only 1 cell reference then ...
ReDim col_nums_Array(1 To 1) ' Set col_nums_Array to a 1D 1 based array the size of 1 row & 1 column
col_nums_Array(1) = col_nums(0).Value2 ' Save the cell value to col_nums_Array
ColumnsChosenCount = 1 ' Set the ColumnsChosenCount = 1
Else ' Else ...
ReDim col_nums_Array(1 To UBound(col_nums) + 1) ' Set col_nums_Array to 1D 1 based size of 1 row & UBound(col_nums) + 1 column
'
For ArrayColumn = 1 To UBound(col_nums) + 1 ' Loop through the cell references
col_nums_Array(ArrayColumn) = col_nums(ArrayColumn - 1).Value2 ' Save the cell value to col_nums_Array
Next ' Loop back
'
ColumnsChosenCount = UBound(col_nums) + 1 ' Set the ColumnsChosenCount to the # of cell references
End If
'
MaximumDimension = 1 ' Set MaximumDimension = 1
Else ' Else ...
col_nums_Array = col_nums(0).Value2 ' Save the range of values to col_nums_Array
col_nums_Array = Application.index(col_nums_Array, 1, 0) ' Convert the 2D array to a 1D array
MaximumDimension = 1 ' Set MaximumDimension = 1
ColumnsChosenCount = UBound(col_nums_Array) ' Save the # of ColsChosen to ColumnsChosenCount
End If
Else ' Else ...
'
' col_nums is an array
For ChosenColumnNumber = LBound(col_nums) To UBound(col_nums) ' Loop through columns chosen
If IsArray(col_nums(ChosenColumnNumber)) Then ' If the columns chosen are an array of chosen #s then ...
col_nums_Array = col_nums(ChosenColumnNumber) ' Save the array of #s to col_nums_Array
'
' Get # of dimensions of a passed array
On Error Resume Next ' If error occurs in next few lines, ignore it & proceed to next line
Do Until ArrayDimensionFoundValue = 999 ' Loop until ArrayDimensionFoundValue = 999
MaximumDimension = MaximumDimension + 1 ' Increment MaximumDimension
ArrayDimensionFoundValue = 999 ' Set ArrayDimensionFoundValue = 999
ArrayDimensionFoundValue = UBound(col_nums_Array, MaximumDimension) ' Test to see if the incremented dimension in col_nums_Array exists
Loop ' Loop back
On Error GoTo 0 ' Return error handling back to Excel
'
MaximumDimension = MaximumDimension - 1 ' Correct MaximumDimension to the correct dimension value of col_nums_Array
'
If MaximumDimension > 1 Then ' If col_nums_Array is > 1 dimensional array then ...
For ArrayColumn = LBound(col_nums_Array, 2) To UBound(col_nums_Array, 2) ' Loop through columns of col_nums_Array
col_nums_Array(1, ArrayColumn) = Replace(col_nums_Array(1, ArrayColumn), ";", _
Application.International(xlListSeparator)) ' Replace any semicolons in the passed array with the Local ListSeparator
Next ' Loop back
End If
'
col_nums(ChosenColumnNumber) = col_nums_Array ' Save col_nums_Array back to col_nums(ChosenColumnNumber)
ColumnsChosenCount = UBound(col_nums_Array) ' Save the # of ColsChosen to ColumnsChosenCount
Else ' Else ...
col_nums(ChosenColumnNumber) = Replace(col_nums(ChosenColumnNumber), ";", _
Application.International(xlListSeparator)) ' Replace any semicolons in the passed array with the Local ListSeparator
ColumnsChosenCount = ColumnsChosenCount + 1 ' Increment ColumnsChosenCount
End If
Next ' Loop back
End If
'
If TypeName(col_nums(0)) = "Range" Then col_nums = col_nums_Array ' If col_nums(0) is a range then Save col_nums_Array to col_nums
ReDim CHOOSECOLS_Array(1 To data.rows.count, 1 To ColumnsChosenCount) ' Establish size of CHOOSECOLS_Array
'
ArrayColumn = 1 ' Initialize ArrayColumn
'
For ChosenColumnNumber = LBound(col_nums) To UBound(col_nums) ' Loop through the columns chosen
If IsArray(col_nums(ChosenColumnNumber)) Then ' If columns chosen are in an array then ...
For DataColumnNumber = LBound(col_nums(ChosenColumnNumber)) To UBound(col_nums(ChosenColumnNumber)) ' Loop
If MaximumDimension = 1 Then ' If 1 Dimension array then ...
If col_nums(ChosenColumnNumber)(DataColumnNumber) = 0 Or _
Abs(col_nums(ChosenColumnNumber)(DataColumnNumber)) > data.columns.count Then ' If DataColumnNumber = 0 or larger than the data range then ...
CHOOSECOLS = CVErr(xlErrValue) ' Save error message to CHOOSECOLS
Exit Function ' Exit the function
End If
'
If col_nums(ChosenColumnNumber)(DataColumnNumber) > 0 Then ' If the column # is a positive number then ...
TempArray = Application.index(data.value, Evaluate("ROW(1:" & data.rows.count & ")"), _
col_nums(ChosenColumnNumber)(DataColumnNumber)) ' Save the data from that column into TempArray
Else ' Else ...
TempArray = Application.index(data.value, Evaluate("ROW(1:" & data.rows.count & ")"), _
data.columns.count + col_nums(ChosenColumnNumber)(DataColumnNumber) + 1) ' Save data from column # counting from the right
End If
Else ' Else ...
If col_nums(ChosenColumnNumber)(DataColumnNumber, 1) = 0 Or _
Abs(col_nums(ChosenColumnNumber)(DataColumnNumber, 1)) > data.rows.count Then ' If DataColumnNumber = 0 or larger than the data range then ...
CHOOSECOLS = CVErr(xlErrValue) ' Save error message to CHOOSECOLS
Exit Function ' Exit the function
End If
'
If col_nums(ChosenColumnNumber)(DataColumnNumber, 1) > 0 Then ' If the columns # is a positive number then ...
TempArray = Application.index(data.value, Evaluate("ROW(1:" & data.rows.count & ")"), _
col_nums(ChosenColumnNumber)(DataColumnNumber, 1)) ' Save the data from that row into TempArray
Else ' Else ...
TempArray = Application.index(data.value, Evaluate("ROW(1:" & data.rows.count & ")"), _
data.columns.count + col_nums(ChosenColumnNumber)(DataColumnNumber, 1) + 1) ' Save data from column # counting from the right into TempArray
End If
End If
'
For ArrayRow = 1 To data.rows.count ' Loop through rows of TempArray
CHOOSECOLS_Array(ArrayRow, ArrayColumn) = TempArray(ArrayRow, 1) ' Save value into CHOOSECOLS_Array
Next ' Loop back
'
ArrayColumn = ArrayColumn + 1 ' Increment ArrayColumn
Next ' Loop back
Else ' Else ...
If col_nums(ChosenColumnNumber) = 0 Or Abs(col_nums(ChosenColumnNumber)) > data.columns.count Then ' If ChosenColumnNumber value = 0 or larger than the data range then ...
CHOOSECOLS = CVErr(xlErrValue) ' Save error message to CHOOSECOLS
Exit Function ' Exit the function
End If
'
If col_nums(ChosenColumnNumber) > 0 Then ' If the column # is a positive number then ...
TempArray = Application.index(data.value, Evaluate("ROW(1:" & data.rows.count & ")"), _
col_nums(ChosenColumnNumber)) ' Save the data from that column into TempArray
Else ' Else ...
TempArray = Application.index(data.value, Evaluate("ROW(1:" & data.rows.count & ")"), _
data.columns.count + col_nums(ChosenColumnNumber) + 1) ' Save data from column counting from the right into TempArray
End If
'
For ArrayRow = 1 To data.rows.count ' Loop through columns of TempArray
CHOOSECOLS_Array(ArrayRow, ArrayColumn) = TempArray(ArrayRow, 1) ' Save value into CHOOSECOLS_Array
Next ' Loop back
'
ArrayColumn = ArrayColumn + 1 ' Increment ArrayColumn
End If
Next ' Loop back
'
CHOOSECOLS = CHOOSECOLS_Array '
End FunctionLet me know your positive or negative results, please give examples of what you tested when posting your results so we can make any corrections that I am sure will need to be made.
