CODEWITHSUNDEEP
excelvba
DA69
DA69

Reputation: 91

Excel VBA function to concatenate non-empty cells with a user defined seperator

I have found this code:

Function ConcatenateRange(ByVal cell_range As Range, _
                    Optional ByVal seperator As String) As String

Dim cell As Range
Dim newString As String
Dim cellArray As Variant
Dim i As Long, j As Long

cellArray = cell_range.Value

For i = 1 To UBound(cellArray, 1)
    For j = 1 To UBound(cellArray, 2)
        If Len(cellArray(i, j)) <> 0 Then
            newString = newString & (seperator & cellArray(i, j))
        End If
    Next
Next

If Len(newString) <> 0 Then
    newString = Right$(newString, (Len(newString) - Len(seperator)))
End If

ConcatenateRange = newString

End Function

It combines a range into one cell (CONCATENATES the cells and adds a space between each part). I have tried many times in vain to edit it to add a "," between each item instead. The issue is that it references the range A1:A1000, where I may only use 10 Rows or all of them. I just dont want it to have extra ,,,,,, at the end of the combine for each cell I didnt fill.

Would also like to create duplicate of this where it would add a ; to the right of each item.

How do I edit this to add those parts, either left or right but only for the filled cells.

Thank you for any help.

Upvotes: 2

Views: 5044

Answers (3)

GlennFromIowa
GlennFromIowa

Reputation: 1646

I wrote a function a while ago that is a little more flexible, can trim spaces if desired, etc. Perhaps this will help others that have a similar problem.

Public Function ConcatDelim(ByRef rng As Range, _
    Optional ByVal sDelim As String, _
    Optional ByVal SkipBlanks As Boolean = True, _
    Optional ByVal DoTrim As Boolean = False) As String
' Purpose: Insert Delim between value of each cell in rng
' Inputs:
'   rng = Range to use for values in concatenated string
'   Delim = Delimiter to insert between each value
'   SkipBlanks = If True, must have non-empty value to insert Delim. False will
'               insert delimiters between each cell value, even if blank
'   DoTrim = If True, Trims spaces from cell value before inserting in string
' Returns:
'   String with cell values separated by Delim

    Dim nLoop As Long
    Dim sValue As String
    Dim sResult As String

    If DoTrim Then
        sResult = Trim(rng.Cells(1).Value)
    Else
        sResult = rng.Cells(1).Value
    End If
    For nLoop = 2 To rng.Cells.Count
        If DoTrim Then
            sValue = Trim(rng.Cells(nLoop).Value)
        Else
            sValue = rng.Cells(nLoop).Value
        End If
        If SkipBlanks = False _
            Or ((sResult <> "") And (sValue <> "") And (SkipBlanks)) Then
            sResult = sResult & sDelim
        End If
        sResult = sResult & sValue
    Next nLoop
    ConcatDelim = sResult

End Function

Upvotes: 1

brettdj
brettdj

Reputation: 55682

If you are concatenating a single column with spaces then you can shorten the code to a single line

For A1:A1000 to be concatenated with ,

x = Join(Filter(Application.Transpose(Application.Evaluate("=IF(Len(A1:A1000)>0,A1:a1000,""x"")")), "x", False), ",")

For A1:A1000 to be concatenated with :

x = Join(Filter(Application.Transpose(Application.Evaluate("=IF(Len(A1:A1000)>0,A1:a1000,""x"")")), "x", False), ":")

Upvotes: 1

Jack
Jack

Reputation: 3878

Your Macro already works. =ConcatenateRange(A1:A14,",") where A1 to A4 have numbers 1-4 in them, you'll get 1,2,3,4.

Upvotes: 1

Related Questions