VBA excel efficient way to concatenate an array UDF - excel

Question

I was wondering what would be the most efficient way to create a UDF in VBA that concatenate an range from the worksheet with an additional character, let's say a comma.
I tried some variations, but I always get stuck with one problem, how to resize the array from the range selected in the worksheet automatically.
The bellow code works, but I believe there must be a more efficient way to do it.
Can you guys help me out, please?
Thanks.
Function conc(data As Range) As String
Dim hola() As Variant
t = data.Rows.Count
ReDim hola(1 To t)
a = 1
For Each i In data.Value
hola(a) = i & ","
a = a + 1
Next i
conc = Join(hola)
Erase hola
End Function

Answer 1

For concatenating many strings in one column and many rows (which is what your original is designed to do):
Function vconc(data As Range) As String
vconc = Join(Application.Transpose(data), Chr(44))
End Function
To concatenate many columns of strings in a single row:
Function hconc(data As Range) As String
hconc = Join(Application.Transpose(Application.Transpose(data)), Chr(44))
End Function

Answer 2

Don't know about more efficient. You can concatenate a specific column with
Public Function conc(ByVal data As Range) As String
conc = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(data.Value, 0, 1)), ",")
End Function
The 1 indicates the column number of the array to concatenate.
Subject to limitations of index and transpose.
More than one column:
Public Function conc(ByVal data As Range) As String
Dim i As Long
For i = 1 To data.Columns.Count
conc = conc & Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(data.Value, 0, i)), ",")
Next i
End Function

Answer 3

This function I wrote some time back is pretty efficient and comprehensive...it handles 1d or 2d arrays, and you can skip blanks and add delimiters if you like. For an explanation and worked examples, see http://dailydoseofexcel.com/archives/2014/11/14/string-concatenation-is-like-the-weather/ and for a discussion on the efficiency benefits of the VBA JOIN function vs straight concatenation see http://excellerando.blogspot.com/2012/08/join-and-split-functions-for-2.html
Option Explicit
Public Function JoinText( _
InputRange As Range, _
Optional SkipBlanks As Boolean = False, _
Optional Delimiter As String = ",", _
Optional FieldDelimiter As String = ";", _
Optional EndDelimiter As String = vbNull, _
Optional Transpose As Boolean) As String
'Based on code from Nigel Heffernan at Excellerando.Blogspot.com
'http://excellerando.blogspot.co.nz/2012/08/join-and-split-functions-for-2.html
' Join up a 1 or 2-dimensional array into a string.
' ####################
' # Revision history #
' ####################
' Date (YYYYMMDD) Revised by: Changes:
' 20141114 Jeff Weir Turned into worksheet function, added FinalDelimiter and Transpose options
' 20141115 Jeff Weir Changed FinalDelimiter to EndDelimiter that accepts string, with default of ""
' 20150211 Jeff Weir Changed names of arguments and changed default orientation to Column=>Row
Dim InputArray As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngNext As Long
Dim i_lBound As Long
Dim i_uBound As Long
Dim j_lBound As Long
Dim j_uBound As Long
Dim arrTemp1() As String
Dim arrTemp2() As String
If InputRange.Rows.Count = 1 Then
If InputRange.Columns.Count = 1 Then
GoTo errhandler 'InputRange is a single cell
Else
' Selection is a Row Vector
InputArray = Application.Transpose(InputRange)
End If
Else
If InputRange.Columns.Count = 1 Then
' Selection is a Column Vector
InputArray = InputRange
Transpose = True
Else:
'Selection is 2D range. Transpose it, because our
' default input is data in rows
If Not Transpose Then
InputArray = Application.Transpose(InputRange)
Else: InputArray = InputRange
End If
End If
End If
i_lBound = LBound(InputArray, 1)
i_uBound = UBound(InputArray, 1)
j_lBound = LBound(InputArray, 2)
j_uBound = UBound(InputArray, 2)
ReDim arrTemp1(j_lBound To j_uBound)
ReDim arrTemp2(i_lBound To i_uBound)
lngNext = 1
For i = j_lBound To j_uBound
On Error Resume Next
If SkipBlanks Then
If Transpose Then
ReDim arrTemp2(i_lBound To WorksheetFunction.CountA(InputRange.Columns(i)))
Else
ReDim arrTemp2(i_lBound To WorksheetFunction.CountA(InputRange.Rows(i)))
End If
End If
If Err.Number = 0 Then
k = 1
For j = i_lBound To i_uBound
If SkipBlanks Then
If InputArray(j, i) <> "" Then
arrTemp2(k) = InputArray(j, i)
k = k + 1
End If
Else
arrTemp2(j) = InputArray(j, i)
End If
Next j
arrTemp1(lngNext) = Join(arrTemp2, Delimiter)
lngNext = lngNext + 1
Else:
Err.Clear
End If
Next i
If SkipBlanks Then ReDim Preserve arrTemp1(1 To lngNext - 1)
If lngNext > 2 Then
JoinText = Join(arrTemp1, FieldDelimiter)
Else: JoinText = arrTemp1(1)
End If
If JoinText <> "" Then JoinText = JoinText & EndDelimiter
errhandler:
End Function