Concatenate With Delimiter

Function StringConcat(Sep As String, ParamArray Args()) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' StringConcat
' This function concatenates all the elements in the Args array,
' delimited by the Sep character, into a single string. This function
' can be used in an array formula.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim S As String
Dim N As Long
Dim M As Long
Dim R As Range
Dim NumDims As Long
Dim LB As Long
Dim IsArrayAlloc As Boolean

'''''''''''''''''''''''''''''''''''''''''''
' If no parameters were passed in, return
' vbNullString.
'''''''''''''''''''''''''''''''''''''''''''
If UBound(Args) - LBound(Args) + 1 = 0 Then
    StringConcat = vbNullString
    Exit Function
End If


For N = LBound(Args) To UBound(Args)
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ' Loop through the Args
    ''''''''''''''''''''''''''''''''''''''''''''''''
    If IsObject(Args(N)) = True Then
        '''''''''''''''''''''''''''''''''''''
        ' OBJECT
        ' If we have an object, ensure it
        ' it a Range. The Range object
        ' is the only type of object we'll
        ' work with. Anything else causes
        ' a #VALUE error.
        ''''''''''''''''''''''''''''''''''''
        If TypeOf Args(N) Is Excel.Range Then
            '''''''''''''''''''''''''''''''''''''''''
            ' If it is a Range, loop through the
            ' cells and create append the elements
            ' to the string S.
            '''''''''''''''''''''''''''''''''''''''''
            For Each R In Args(N).Cells
                S = S & R.Text & Sep
            Next R
        Else
            '''''''''''''''''''''''''''''''''
            ' Unsupported object type. Return
            ' a #VALUE error.
            '''''''''''''''''''''''''''''''''
            StringConcat = CVErr(xlErrValue)
            Exit Function
        End If
    
    ElseIf IsArray(Args(N)) = True Then
        
        On Error Resume Next
        '''''''''''''''''''''''''''''''''''''
        ' ARRAY
        ' If Args(N) is an array, ensure it
        ' is an allocated array.
        '''''''''''''''''''''''''''''''''''''
        IsArrayAlloc = (Not IsError(LBound(Args(N))) And _
            (LBound(Args(N)) <= UBound(Args(N))))
        On Error GoTo 0
        If IsArrayAlloc = True Then
            ''''''''''''''''''''''''''''''''''''
            ' The array is allocated. Determine
            ' the number of dimensions of the
            ' array.
            '''''''''''''''''''''''''''''''''''''
            NumDims = 1
            On Error Resume Next
            Err.Clear
            NumDims = 1
            Do Until Err.Number <> 0
                LB = LBound(Args(N), NumDims)
                If Err.Number = 0 Then
                    NumDims = NumDims + 1
                Else
                    NumDims = NumDims - 1
                End If
            Loop
            ''''''''''''''''''''''''''''''''''
            ' The array must have either
            ' one or two dimensions. Greater
            ' that two caues a #VALUE error.
            ''''''''''''''''''''''''''''''''''
            If NumDims > 2 Then
                StringConcat = CVErr(xlErrValue)
                Exit Function
            End If
            If NumDims = 1 Then
                For M = LBound(Args(N)) To UBound(Args(N))
                    If Args(N)(M) <> vbNullString Then
                        S = S & Args(N)(M) & Sep
                    End If
                Next M
                
            Else
                For M = LBound(Args(N), 1) To UBound(Args(N), 1)
                    If Args(N)(M, 1) <> vbNullString Then
                        S = S & Args(N)(M, 1) & Sep
                    End If
                Next M
                For M = LBound(Args(N), 2) To UBound(Args(N), 2)
                    If Args(N)(M, 2) <> vbNullString Then
                        S = S & Args(N)(M, 2) & Sep
                    End If
                Next M

            End If
        Else
            S = S & Args(N) & Sep
        End If
    Else
        S = S & Args(N) & Sep
    End If
Next N

'''''''''''''''''''''''''''''''''''
' Remove the trailing Sep character
'''''''''''''''''''''''''''''''''''
If Len(Sep) > 0 Then
    S = Left(S, Len(S) - Len(Sep))
End If

StringConcat = S

End Function

Private Function myCate(Target As Range)
 
Dim c As Range
Dim Temp As String
 
For Each c In Target
 
If c = "" Then
     'do nothing
  Else
     Temp = Temp & c.Value & ","
End If
 
Next
 
myCate = Mid(Temp, 1, Len(Temp) - 1)
 
End Function