How do I make an excel vba function that can handle vertical and horizontal ranges

Question

I saw this: Excel VBA: Determine if range is horizontal or vertical

I have this function that joins text if it's vertical:

Function textjoiner(x As Range, Optional delimiter As String = ",") As String
    Dim darray() As Variant
    Dim darray2() As Variant
    Dim counter As Long, i As Long
    darray = x.value
    counter = UBound(darray, 1)
    ReDim darray2(1 To counter)
    For i = 1 To counter
        darray2(i) = darray(i, 1)
    Next i
    textjoiner = join(darray2, delimiter)
End Function

What's the easiest way to modify it so it doestn' matter if it's an 1xn or nx1 range of cells, it will concatenate anyway?

If you want a Textjoin UDF, perhaps [here](https://stackoverflow.com/questions/39532189/vlookup-with-multiple-criteria-returning-values-in-one-cell). — BigBen, Jun 11 '21 at 01:38

score 2 · Accepted Answer · answered Jun 11 '21 at 04:02

Function textjoiner(xRange As Range, Optional delimiter As String = ",") As String
    Dim oRet As String
    oRet = ""
    
    'Ensure we are dealing with a nx1 or 1xn range
    If xRange.Rows.Count = 1 Or xRange.Columns.Count = 1 Then
    
        'Concatenate each value in Range and add delimter
        For Each oValue In xRange
            oRet = oRet & oValue & delimiter
        Next
        
        ' Remove last delimiter
        oRet = Left(oRet, Len(oRet) - Len(delimiter))
    End If
    
    textjoiner = oRet
End Function

Yeah, you're much smarter than me. Thanks! – Henrietta Martingale Jun 11 '21 at 14:48 — Henrietta Martingale, Jun 11 '21 at 14:48

score 0 · Answer 2 · answered Jun 11 '21 at 02:40

Handle Ranges

The following will work for any contiguous (one-area) range.
ByColumns set to True will allow reading one column at a time (default is one row at a time).

Option Explicit

Function TextJoiner( _
    ByVal rg As Range, _
    Optional ByVal Delimiter As String = ",", _
    Optional ByVal ByColumns As Boolean = False) _
As String
    
    If rg Is Nothing Then Exit Function
    
    Dim rCount As Long: rCount = rg.Rows.Count
    Dim cCount As Long: cCount = rg.Columns.Count
    
    Dim sData As Variant
    If rCount + cCount = 2 Then
        ReDim sData(1 To 1, 1 To 1): sData(1, 1) = rg.Value
    Else
        sData = rg.Value
    End If
    
    Dim nCount As Long: nCount = rCount * cCount
    Dim nData As Variant: ReDim nData(1 To nCount)
    
    Dim cValue As Variant
    Dim r As Long, c As Long, n As Long
    
    If ByColumns Then
        For c = 1 To cCount
            For r = 1 To rCount
                cValue = sData(r, c)
                If Not IsError(cValue) Then
                    If Len(cValue) > 0 Then
                        n = n + 1
                        nData(n) = cValue
                    End If
                End If
            Next r
        Next c
    Else
        For r = 1 To rCount
            For c = 1 To cCount
                cValue = sData(r, c)
                If Not IsError(cValue) Then
                    If Len(cValue) > 0 Then
                        n = n + 1
                        nData(n) = cValue
                    End If
                End If
            Next c
        Next r
    End If
    
    If n < nCount Then
        ReDim Preserve nData(1 To n)
    End If
    
    TextJoiner = Join(nData, Delimiter)
    
End Function

How do I make an excel vba function that can handle vertical and horizontal ranges

2 Answers2

Handle Ranges