CODEWITHSUNDEEP
excelvbanamed-ranges
aye cee
aye cee

Reputation: 193

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

Upvotes: 0

Views: 271

Answers (1)

Алексей Р
Алексей Р

Reputation: 7627

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

Upvotes: 2

Related Questions