CODEWITHSUNDEEP
excelvbaperformance
Jorge Silva
Jorge Silva

Reputation: 55

VBA excel efficient way to concatenate an array UDF

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

Upvotes: 3

Views: 1508

Answers (3)

QHarr
QHarr

Reputation: 84465

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

Upvotes: 3

jeffreyweir
jeffreyweir

Reputation: 4834

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

Upvotes: 0

user4039065
user4039065

Reputation:

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

Upvotes: 4

Related Questions