Search code examples
excelvbanamed-ranges

Excel user defined function to accept named range intsead of cell range


Have followed some instructions to create a user defined function to replicate the TEXTJOIN function in recent versions of Excel. It works to create a function that you can then use as any other, to output contents of a cell range to a single cell, separated by commas.

This works well however I have been unable to get this function to accept a named range instead of a cell range. Is this possible?

Syntax is as follows: =My_Text_Join(“,”,1, name-of-namedrange)

Option Explicit
Function My_Text_Join(delimiter As String, ignore_empty As Boolean, text_range As Range) As String

Application.Volatile
Dim c As Range
Dim n As Long
n = 0
For Each c In text_range
 If ignore_empty = True Then
 If VBA.IsEmpty(c.Value) = False Then
 If n = 0 Then
 My_Text_Join = c.Value
 Else
 My_Text_Join = My_Text_Join & delimiter & c.Value
 End If
 n = n + 1
 End If
 
 Else
 
 If n = 0 Then
 My_Text_Join = c.Value
 Else
 My_Text_Join = My_Text_Join & delimiter & c.Value
 End If
 n = n + 1
 
 End If
Next

End Function

Solution

  • Try this code (can take a variable number of arguments of different types - contiguous or non-contiguous ranges, names, constants; e.g =TXTJOIN("/",THENAME,C1:C3,"Fourth",777):

    Edit: Added feature - if an argument can be evaluated as Range, it will be converted to Range: if name THENAME was defined, =TXTJOIN("/","THENAME",C1:C3,"Fourth",777) and =TXTJOIN("/",THENAME,C1:C3,"Fourth",777) outputs the same result

    Option Explicit
    
    Public Function TXTJOIN(Delimiter As String, ParamArray args() As Variant)
        Dim A As Variant, cl As Range
        TXTJOIN = vbNullString
        For Each A In args
            On Error Resume Next
            Set A = Names(A).RefersToRange    ' if an argument can be evaluated as Range, it will be converted to Range
            On Error GoTo 0
            Select Case TypeName(A)
                Case "Range"
                    For Each cl In A
                        TXTJOIN = IIf(TXTJOIN = vbNullString, cl.Text, _
                                  TXTJOIN & Delimiter & cl.Text)
                    Next
                Case Else
                    TXTJOIN = IIf(TXTJOIN = vbNullString, A, _
                              TXTJOIN & Delimiter & A)
            End Select
        Next
    End Function
    

    Edit2: refactoring has been done, added skipEmpty, fixed Names issue

    Option Explicit
    
    Public Function TXTJOIN(Delimiter As String, skipEmpty As Boolean, ParamArray args() As Variant) As String
        Dim A As Variant, cl As Range, buffer As String
        For Each A In args
            If TypeName(A) = "String" Then ' if an *string* argument can be evaluated as Range, it will be done
                On Error Resume Next
                Set A = Names(A).RefersToRange
                On Error GoTo 0
            End If
            If TypeName(A) = "Range" Then
                For Each cl In A
                    buffer = cl.text    ' buffer is used to minimize the number of cell reads
                    If Not skipEmpty Or Len(buffer) > 0 Then _
                       TXTJOIN = TXTJOIN & Delimiter & buffer
                Next cl
            Else
                If Not skipEmpty Or Len(A) > 0 Then _
                    TXTJOIN = TXTJOIN & Delimiter & A
            End If
        Next A
        TXTJOIN = Mid(TXTJOIN, Len(Delimiter) + 1) ' remove lead Delimiter occur
    End Function