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 CHOOSEROWS.
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 CHOOSEROWS.
VBA Code:
Function CHOOSEROWS(data As Range, ParamArray row_nums() As Variant) As Variant ' Excel 365
'
Dim ArrayColumn As Long, ArrayRow As Long
Dim ArrayDimensionFoundValue As Long, MaximumDimension As Long
Dim DataRowNumber As Long, ChosenRowNumber As Long, RowsChosenCount As Long
Dim CHOOSEROWS_Array As Variant, row_nums_Array As Variant, TempArray As Variant
'
' Check if input is a range or array
If TypeName(row_nums(0)) = "Range" Then ' If row_nums(0) is a range then ...
If row_nums(0).Cells.count = 1 Then ' If the range(0) is detected as 1 cell then ...
If UBound(row_nums) = 0 Then ' If there is only 1 cell reference then ...
ReDim row_nums_Array(1 To 1) ' Set row_nums_Array to a 1D 1 based array the size of 1 row & 1 column
row_nums_Array(1) = row_nums(0).Value2 ' Save the cell value to row_nums_Array
RowsChosenCount = 1 ' Set the RowsChosenCount = 1
Else ' Else ...
ReDim row_nums_Array(1 To UBound(row_nums) + 1) ' Set row_nums_Array to 1D 1 based size of 1 row & UBound(row_nums) + 1 column
'
For ArrayColumn = 1 To UBound(row_nums) + 1 ' Loop through the cell references
row_nums_Array(ArrayColumn) = row_nums(ArrayColumn - 1).Value2 ' Save the cell value to row_nums_Array
Next ' Loop back
'
RowsChosenCount = UBound(row_nums) + 1 ' Set the RowsChosenCount to the # of cell references
End If
'
MaximumDimension = 1 ' Set MaximumDimension = 1
Else ' Else ...
row_nums_Array = row_nums(0).Value2 ' Save the range of values to row_nums_Array
row_nums_Array = Application.index(row_nums_Array, 1, 0) ' Convert the 2D array to a 1D array
MaximumDimension = 1 ' Set MaximumDimension = 1
RowsChosenCount = UBound(row_nums_Array) ' Save the # of RowsChosen to RowsChosenCount
End If
Else ' Else ...
'
' row_nums is an array
For ChosenRowNumber = LBound(row_nums) To UBound(row_nums) ' Loop through rows chosen
If IsArray(row_nums(ChosenRowNumber)) Then ' If the rows chosen are an array of chosen #s then ...
row_nums_Array = row_nums(ChosenRowNumber) ' Save the array of #s to row_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(row_nums_Array, MaximumDimension) ' Test to see if the incremented dimension in row_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 row_nums_Array
'
If MaximumDimension > 1 Then ' If row_nums_Array is > 1 dimensional array then ...
For ArrayRow = LBound(row_nums_Array, 1) To UBound(row_nums_Array, 1) ' Loop through rows of (row_nums_Array, 1)
row_nums_Array(ArrayRow, 1) = Replace(row_nums_Array(ArrayRow, 1), ";", _
Application.International(xlListSeparator)) ' Replace any semicolons in the passed array with the Local ListSeparator
Next ' Loop back
End If
'
row_nums(ChosenRowNumber) = row_nums_Array ' Save row_nums_Array back to row_nums(ChosenRowNumber)
RowsChosenCount = UBound(row_nums_Array) ' Save the # of RowsChosen to RowsChosenCount
Else ' Else ...
row_nums(ChosenRowNumber) = Replace(row_nums(ChosenRowNumber), ";", _
Application.International(xlListSeparator)) ' Replace any semicolons in the passed array with the Local ListSeparator
RowsChosenCount = RowsChosenCount + 1 ' Increment RowsChosenCount
End If
Next ' Loop back
End If
'
If TypeName(row_nums(0)) = "Range" Then row_nums = row_nums_Array ' If row_nums(0) is a range then Save row_nums_Array to row_nums
ReDim CHOOSEROWS_Array(1 To RowsChosenCount, 1 To data.columns.count) ' Establish size of CHOOSEROWS_Array
'
ArrayRow = 1 ' Initialize ArrayRow
'
For ChosenRowNumber = LBound(row_nums) To UBound(row_nums) ' Loop through the rows chosen
If IsArray(row_nums(ChosenRowNumber)) Then ' If rows chosen are in an array then ...
For DataRowNumber = LBound(row_nums(ChosenRowNumber)) To UBound(row_nums(ChosenRowNumber)) ' Loop
If MaximumDimension = 1 Then ' If 1 Dimension array then ...
If row_nums(ChosenRowNumber)(DataRowNumber) = 0 Or _
Abs(row_nums(ChosenRowNumber)(DataRowNumber)) > data.rows.count Then ' If DataRowNumber = 0 or larger than the data range then ...
CHOOSEROWS = CVErr(xlErrValue) ' Save error message to CHOOSEROWS
Exit Function ' Exit the function
End If
'
If row_nums(ChosenRowNumber)(DataRowNumber) > 0 Then ' If the row # is a positive number then ...
TempArray = Application.index(data.value, row_nums(ChosenRowNumber)(DataRowNumber), _
Evaluate("COLUMN(1:" & data.columns.count & ")")) ' Save the data from that row into TempArray
Else ' Else ...
TempArray = Application.index(data.value, data.rows.count + _
row_nums(ChosenRowNumber)(DataRowNumber) + 1, Evaluate("COLUMN(1:" & _
data.columns.count & ")")) ' Save data from row # counting from last row into TempArray
End If
Else ' Else ...
If row_nums(ChosenRowNumber)(DataRowNumber, 1) = 0 Or _
Abs(row_nums(ChosenRowNumber)(DataRowNumber, 1)) > data.rows.count Then ' If DataRowNumber = 0 or larger than the data range then ...
CHOOSEROWS = CVErr(xlErrValue) ' Save error message to CHOOSEROWS
Exit Function ' Exit the function
End If
'
If row_nums(ChosenRowNumber)(DataRowNumber, 1) > 0 Then ' If the row # is a positive number then ...
TempArray = Application.index(data.value, row_nums(ChosenRowNumber)(DataRowNumber, 1), _
Evaluate("COLUMN(1:" & data.columns.count & ")")) ' Save the data from that row into TempArray
Else ' Else ...
TempArray = Application.index(data.value, data.rows.count + _
row_nums(ChosenRowNumber)(DataRowNumber, 1) + 1, _
Evaluate("COLUMN(1:" & data.columns.count & ")")) ' Save data from row # counting from last row into TempArray
End If
End If
'
For ArrayColumn = 1 To data.columns.count ' Loop through columns of TempArray
CHOOSEROWS_Array(ArrayRow, ArrayColumn) = TempArray(ArrayColumn) ' Save value into CHOOSEROWS_Array
Next ' Loop back
'
ArrayRow = ArrayRow + 1 ' Increment ArrayRow
Next ' Loop back
Else ' Else ...
If row_nums(ChosenRowNumber) = 0 Or Abs(row_nums(ChosenRowNumber)) > data.rows.count Then ' If ChosenRowNumber value = 0 or larger than the data range then ...
CHOOSEROWS = CVErr(xlErrValue) ' Save error message to CHOOSEROWS
Exit Function ' Exit the function
End If
'
If row_nums(ChosenRowNumber) > 0 Then ' If the row # is a positive number then ...
TempArray = Application.index(data.value, row_nums(ChosenRowNumber), _
Evaluate("COLUMN(1:" & data.columns.count & ")")) ' Save the data from that row into TempArray
Else ' Else ...
TempArray = Application.index(data.value, data.rows.count + row_nums(ChosenRowNumber) + 1, _
Evaluate("COLUMN(1:" & data.columns.count & ")")) ' Save data from row counting from last row into TempArray
End If
'
For ArrayColumn = 1 To data.columns.count ' Loop through columns of TempArray
CHOOSEROWS_Array(ArrayRow, ArrayColumn) = TempArray(ArrayColumn) ' Save value into CHOOSEROWS_Array
Next ' Loop back
'
ArrayRow = ArrayRow + 1 ' Increment ArrayRow
End If
Next ' Loop back
'
CHOOSEROWS = CHOOSEROWS_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.
