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 the excel 365 function ARRAYTOTEXT.
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 the excel 365 function ARRAYTOTEXT.
VBA Code:
Function ARRAYTOTEXT(array_input As Variant, Optional format As Integer = 0) As String
'
Dim ArrayColumn As Long, ArrayRow As Long
Dim InnerArrayRow As Long
Dim MaximumColumns As Long, MaximumRows As Long
Dim ErrorValue As String, TempString As String
Dim ConvertedErrorArray As Variant, LookupErrorArray As Variant, TempArray() As Variant
'
LookupErrorArray = Array("Error 2015", "Error 2023", "Error 2036", "Error 2000", "Error 2029", "Error 2042", "Error 2007")
ConvertedErrorArray = Array("#VALUE!", "#REF!", "#NUM!", "#NULL!", "#NAME?", "#N/A", "#DIV/0!")
'
' format value handler
If format <> 0 And format <> 1 Then ' If the format value is not = zero or one then ...
ARRAYTOTEXT = CVErr(xlErrValue) ' Set ARRAYTOTEXT to the error message
Exit Function ' Exit the function
End If
'
' Check if input is a range or array
If TypeName(array_input) = "Range" Then ' If array_input is a range then ...
If array_input.Cells.count = 1 Then ' If the range is only 1 cell then ...
ReDim TempArray(1 To 1, 1 To 1) ' Set TempArray to a 2D 1 based size of 1 row & 1 column
TempArray(1, 1) = array_input.value ' Save the cell value to TempArray
Else ' Else ...
TempArray = array_input.value ' Save the range of values to TempArray
End If
ElseIf IsArray(array_input) Then ' Else if array_input is an array then ...
TempArray = array_input ' Save it to TempArray
Else ' Else ...
ARRAYTOTEXT = "Error: Invalid Input" ' Save error message to ARRAYTOTEXT
Exit Function ' Exit the function
End If
'
MaximumRows = UBound(TempArray, 1) ' Get # of rows in TempArray
MaximumColumns = UBound(TempArray, 2) ' Get # of columns in TempArray
'
'---------------------------------------------------------------------------------------------------------------
'
' Loop through each element of array and build string
For ArrayRow = 1 To MaximumRows '
For ArrayColumn = 1 To MaximumColumns '
'
' Error handler for TempArray(ArrayRow, ArrayColumn)
If IsError(TempArray(ArrayRow, ArrayColumn)) Then '
For InnerArrayRow = LBound(LookupErrorArray) To UBound(LookupErrorArray) ' Loop through the LookupErrorArray to find the matching position in the array
If CStr(TempArray(ArrayRow, ArrayColumn)) = LookupErrorArray(InnerArrayRow) Then ' When the matching position is found in LookupErrorArray
ErrorValue = ConvertedErrorArray(InnerArrayRow) ' Save the corresponding value positioned in the ConvertedErrorArray into VALUETOTEXT
Exit For '
End If
Next ' Loop back
'
If TempString <> "" Then '
If format = 0 Then '
TempString = TempString & ", " & ErrorValue '
Else '
TempString = TempString & ";" & ErrorValue '
End If
Else '
TempString = ErrorValue '
End If
'
' Boolean handler for TempArray(ArrayRow, ArrayColumn)
ElseIf VarType(TempArray(ArrayRow, ArrayColumn)) = vbBoolean Then '
If TempString <> "" Then '
If format = 0 Then '
TempString = TempString & ", " & UCase(CStr(TempArray(ArrayRow, ArrayColumn))) '
Else '
TempString = TempString & ";" & UCase(CStr(TempArray(ArrayRow, ArrayColumn))) '
End If
Else '
TempString = UCase(CStr(TempArray(ArrayRow, ArrayColumn))) '
End If
'
' Numeric & Date handler for TempArray(ArrayRow, ArrayColumn)
ElseIf IsNumeric(TempArray(ArrayRow, ArrayColumn)) Or IsDate(TempArray(ArrayRow, ArrayColumn)) Then ' If value is a Number or a Date
If IsDate(TempArray(ArrayRow, ArrayColumn)) Then _
TempArray(ArrayRow, ArrayColumn) = CLng(TempArray(ArrayRow, ArrayColumn)) '
'
If TempString <> "" Then '
If format = 0 Then '
TempString = TempString & ", " & CStr(TempArray(ArrayRow, ArrayColumn)) '
Else '
TempString = TempString & ";" & CStr(TempArray(ArrayRow, ArrayColumn)) '
End If
Else '
TempString = CStr(TempArray(ArrayRow, ArrayColumn)) '
End If
'
' String handler for TempArray(ArrayRow, ArrayColumn)
Else '
If TempString <> "" Then '
If format = 0 Then '
TempString = TempString & ", " & CStr(TempArray(ArrayRow, ArrayColumn)) '
Else '
TempString = TempString & ";" & Chr(34) & CStr(TempArray(ArrayRow, _
ArrayColumn)) & Chr(34) '
End If
Else '
If format = 0 Then '
TempString = CStr(TempArray(ArrayRow, ArrayColumn)) '
Else '
TempString = Chr(34) & CStr(TempArray(ArrayRow, ArrayColumn)) & Chr(34) '
End If
End If
End If
Next '
Next '
'
If format = 1 Then TempString = "{" & TempString & "}" '
'
' Return final string
ARRAYTOTEXT = TempString '
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.
